7. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 4/28/2017 1:53:41 PM Central Daylight Time. See www.araxis.com for information about Merge. This report uses XHTML and CSS2, and is best viewed with a modern standards-compliant browser. For optimum results when printing this report, use landscape orientation and enable printing of background images and colours in your browser.

7.1 Files compared

# Location File Last Modified
1 MCCF.zip\MCCF IB_2_582_TEST_V2.KID Wed Apr 26 20:27:12 2017 UTC
2 MCCF.zip\MCCF IB_2_582_TEST_V2.KID Fri Apr 28 18:31:16 2017 UTC

7.2 Comparison summary

Description Between
Files 1 and 2
Text Blocks Lines
Unchanged 4 29586
Changed 3 6
Inserted 0 0
Removed 0 0

7.3 Comparison options

Whitespace
Character case Differences in character case are significant
Line endings Differences in line endings (CR and LF characters) are ignored
CR/LF characters Not shown in the comparison detail

7.4 Active regular expressions

No regular expressions were active.

7.5 Comparison detail

  1   IB*2*582 T EST v2
  2   Extracted  from mail  message
  3   **KIDS**:I B*2.0*582^
  4  
  5   **INSTALL  NAME**
  6   IB*2.0*582
  7   "BLD",1045 9,0)
  8   IB*2.0*582 ^INTEGRATE D BILLING^ 0^3170320^ y
  9   "BLD",1045 9,4,0)
  10   ^9.64PA^20 0^1
  11   "BLD",1045 9,4,200,0)
  12   200
  13   "BLD",1045 9,4,200,22 2)
  14   y^n^f^^n^^ y^m^n
  15   "BLD",1045 9,4,200,22 3)
  16  
  17   "BLD",1045 9,4,200,22 4)
  18   I $$INC200 ^IBY582PR( Y)
  19   "BLD",1045 9,4,"B",20 0,200)
  20  
  21   "BLD",1045 9,6.3)
  22   77
  23   "BLD",1045 9,"ABPKG")
  24   n
  25   "BLD",1045 9,"INI")
  26  
  27   "BLD",1045 9,"INID")
  28   n^n^n
  29   "BLD",1045 9,"INIT")
  30  
  31   "BLD",1045 9,"KRN",0)
  32   ^9.67PA^77 9.2^20
  33   "BLD",1045 9,"KRN",.4 ,0)
  34   .4
  35   "BLD",1045 9,"KRN",.4 ,"NM",0)
  36   ^9.68A^^
  37   "BLD",1045 9,"KRN",.4 01,0)
  38   .401
  39   "BLD",1045 9,"KRN",.4 02,0)
  40   .402
  41   "BLD",1045 9,"KRN",.4 02,"NM",0)
  42   ^9.68A^^0
  43   "BLD",1045 9,"KRN",.4 03,0)
  44   .403
  45   "BLD",1045 9,"KRN",.5 ,0)
  46   .5
  47   "BLD",1045 9,"KRN",.8 4,0)
  48   .84
  49   "BLD",1045 9,"KRN",3. 6,0)
  50   3.6
  51   "BLD",1045 9,"KRN",3. 8,0)
  52   3.8
  53   "BLD",1045 9,"KRN",3. 8,"NM",0)
  54   ^9.68A^1^1
  55   "BLD",1045 9,"KRN",3. 8,"NM",1,0 )
  56   IBCNE EIV  MESSAGE^^0
  57   "BLD",1045 9,"KRN",3. 8,"NM","B" ,"IBCNE EI V MESSAGE" ,1)
  58  
  59   "BLD",1045 9,"KRN",9. 2,0)
  60   9.2
  61   "BLD",1045 9,"KRN",9. 8,0)
  62   9.8
  63   "BLD",1045 9,"KRN",9. 8,"NM",0)
  64   ^9.68A^11^ 7
  65   "BLD",1045 9,"KRN",9. 8,"NM",2,0 )
  66   IBCNEUT7^^ 0^B8201503 3
  67   "BLD",1045 9,"KRN",9. 8,"NM",3,0 )
  68   IBCNEQU^^0 ^B12676825 3
  69   "BLD",1045 9,"KRN",9. 8,"NM",4,0 )
  70   IBCNSP02^^ 0^B1637980 0
  71   "BLD",1045 9,"KRN",9. 8,"NM",8,0 )
  72   IBCNERTQ^^ 0^B4654170 7
  73   "BLD",1045 9,"KRN",9. 8,"NM",9,0 )
  74   IBY582PR^^ 0^B638375
  75   "BLD",1045 9,"KRN",9. 8,"NM",10, 0)
  76   IBCNCH^^0^ B89930546
  77   "BLD",1045 9,"KRN",9. 8,"NM",11, 0)
  78   IBCNEHLT^^ 0^B9374367 2
  79   "BLD",1045 9,"KRN",9. 8,"NM","B" ,"IBCNCH", 10)
  80  
  81   "BLD",1045 9,"KRN",9. 8,"NM","B" ,"IBCNEHLT ",11)
  82  
  83   "BLD",1045 9,"KRN",9. 8,"NM","B" ,"IBCNEQU" ,3)
  84  
  85   "BLD",1045 9,"KRN",9. 8,"NM","B" ,"IBCNERTQ ",8)
  86  
  87   "BLD",1045 9,"KRN",9. 8,"NM","B" ,"IBCNEUT7 ",2)
  88  
  89   "BLD",1045 9,"KRN",9. 8,"NM","B" ,"IBCNSP02 ",4)
  90  
  91   "BLD",1045 9,"KRN",9. 8,"NM","B" ,"IBY582PR ",9)
  92  
  93   "BLD",1045 9,"KRN",19 ,0)
  94   19
  95   "BLD",1045 9,"KRN",19 ,"NM",0)
  96   ^9.68A^^0
  97   "BLD",1045 9,"KRN",19 .1,0)
  98   19.1
  99   "BLD",1045 9,"KRN",19 .1,"NM",0)
  100   ^9.68A^^
  101   "BLD",1045 9,"KRN",10 1,0)
  102   101
  103   "BLD",1045 9,"KRN",10 1,"NM",0)
  104   ^9.68A^16^ 16
  105   "BLD",1045 9,"KRN",10 1,"NM",1,0 )
  106   IBJT NS VI EW EXP POL  MENU^^0
  107   "BLD",1045 9,"KRN",10 1,"NM",2,0 )
  108   IBJT PATIE NT POLICY  COMMENTS V IEW^^4^
  109   "BLD",1045 9,"KRN",10 1,"NM",3,0 )
  110   IBJ EXIT^^ 4^
  111   "BLD",1045 9,"KRN",10 1,"NM",4,0 )
  112   IBJT BILL  CHARGES SC REEN^^4^
  113   "BLD",1045 9,"KRN",10 1,"NM",5,0 )
  114   IBJT BILL  DX SCREEN^ ^4^
  115   "BLD",1045 9,"KRN",10 1,"NM",6,0 )
  116   IBJT BILL  PROCEDURES  SCREEN^^4 ^
  117   "BLD",1045 9,"KRN",10 1,"NM",7,0 )
  118   IBJT CLAIM  SCREEN SK IP^^4^
  119   "BLD",1045 9,"KRN",10 1,"NM",8,0 )
  120   IBJT AR AC COUNT PROF ILE SCREEN ^^4^
  121   "BLD",1045 9,"KRN",10 1,"NM",9,0 )
  122   IBJT AR CO MMENT HIST ORY SCREEN ^^4^
  123   "BLD",1045 9,"KRN",10 1,"NM",10, 0)
  124   IBJT CT/IR  COMMUNICA TIONS LIST  SCREEN^^4 ^
  125   "BLD",1045 9,"KRN",10 1,"NM",11, 0)
  126   IBJT HS HE ALTH SUMMA RY^^4^
  127   "BLD",1045 9,"KRN",10 1,"NM",12, 0)
  128   IBJT ACTIV E LIST SCR EEN SKIP^^ 4^
  129   "BLD",1045 9,"KRN",10 1,"NM",13, 0)
  130   IBJT NS VI EW INS CO  SCREEN^^4^
  131   "BLD",1045 9,"KRN",10 1,"NM",14, 0)
  132   IBJT NS VI EW EXP POL  REDISPLAY ^^4^
  133   "BLD",1045 9,"KRN",10 1,"NM",15, 0)
  134   IBJT NS VI EW AN BEN  SCREEN^^4^
  135   "BLD",1045 9,"KRN",10 1,"NM",16, 0)
  136   IBJT PT EL IGIBILITY  SCREEN^^4^
  137   "BLD",1045 9,"KRN",10 1,"NM","B" ,"IBJ EXIT ",3)
  138  
  139   "BLD",1045 9,"KRN",10 1,"NM","B" ,"IBJT ACT IVE LIST S CREEN SKIP ",12)
  140  
  141   "BLD",1045 9,"KRN",10 1,"NM","B" ,"IBJT AR  ACCOUNT PR OFILE SCRE EN",8)
  142  
  143   "BLD",1045 9,"KRN",10 1,"NM","B" ,"IBJT AR  COMMENT HI STORY SCRE EN",9)
  144  
  145   "BLD",1045 9,"KRN",10 1,"NM","B" ,"IBJT BIL L CHARGES  SCREEN",4)
  146  
  147   "BLD",1045 9,"KRN",10 1,"NM","B" ,"IBJT BIL L DX SCREE N",5)
  148  
  149   "BLD",1045 9,"KRN",10 1,"NM","B" ,"IBJT BIL L PROCEDUR ES SCREEN" ,6)
  150  
  151   "BLD",1045 9,"KRN",10 1,"NM","B" ,"IBJT CLA IM SCREEN  SKIP",7)
  152  
  153   "BLD",1045 9,"KRN",10 1,"NM","B" ,"IBJT CT/ IR COMMUNI CATIONS LI ST SCREEN" ,10)
  154  
  155   "BLD",1045 9,"KRN",10 1,"NM","B" ,"IBJT HS  HEALTH SUM MARY",11)
  156  
  157   "BLD",1045 9,"KRN",10 1,"NM","B" ,"IBJT NS  VIEW AN BE N SCREEN", 15)
  158  
  159   "BLD",1045 9,"KRN",10 1,"NM","B" ,"IBJT NS  VIEW EXP P OL MENU",1 )
  160  
  161   "BLD",1045 9,"KRN",10 1,"NM","B" ,"IBJT NS  VIEW EXP P OL REDISPL AY",14)
  162  
  163   "BLD",1045 9,"KRN",10 1,"NM","B" ,"IBJT NS  VIEW INS C O SCREEN", 13)
  164  
  165   "BLD",1045 9,"KRN",10 1,"NM","B" ,"IBJT PAT IENT POLIC Y COMMENTS  VIEW",2)
  166  
  167   "BLD",1045 9,"KRN",10 1,"NM","B" ,"IBJT PT  ELIGIBILIT Y SCREEN", 16)
  168  
  169   "BLD",1045 9,"KRN",40 9.61,0)
  170   409.61
  171   "BLD",1045 9,"KRN",40 9.61,"NM", 0)
  172   ^9.68A^^0
  173   "BLD",1045 9,"KRN",77 1,0)
  174   771
  175   "BLD",1045 9,"KRN",77 1,"NM",0)
  176   ^9.68A^^
  177   "BLD",1045 9,"KRN",77 9.2,0)
  178   779.2
  179   "BLD",1045 9,"KRN",87 0,0)
  180   870
  181   "BLD",1045 9,"KRN",89 89.51,0)
  182   8989.51
  183   "BLD",1045 9,"KRN",89 89.52,0)
  184   8989.52
  185   "BLD",1045 9,"KRN",89 94,0)
  186   8994
  187   "BLD",1045 9,"KRN","B ",.4,.4)
  188  
  189   "BLD",1045 9,"KRN","B ",.401,.40 1)
  190  
  191   "BLD",1045 9,"KRN","B ",.402,.40 2)
  192  
  193   "BLD",1045 9,"KRN","B ",.403,.40 3)
  194  
  195   "BLD",1045 9,"KRN","B ",.5,.5)
  196  
  197   "BLD",1045 9,"KRN","B ",.84,.84)
  198  
  199   "BLD",1045 9,"KRN","B ",3.6,3.6)
  200  
  201   "BLD",1045 9,"KRN","B ",3.8,3.8)
  202  
  203   "BLD",1045 9,"KRN","B ",9.2,9.2)
  204  
  205   "BLD",1045 9,"KRN","B ",9.8,9.8)
  206  
  207   "BLD",1045 9,"KRN","B ",19,19)
  208  
  209   "BLD",1045 9,"KRN","B ",19.1,19. 1)
  210  
  211   "BLD",1045 9,"KRN","B ",101,101)
  212  
  213   "BLD",1045 9,"KRN","B ",409.61,4 09.61)
  214  
  215   "BLD",1045 9,"KRN","B ",771,771)
  216  
  217   "BLD",1045 9,"KRN","B ",779.2,77 9.2)
  218  
  219   "BLD",1045 9,"KRN","B ",870,870)
  220  
  221   "BLD",1045 9,"KRN","B ",8989.51, 8989.51)
  222  
  223   "BLD",1045 9,"KRN","B ",8989.52, 8989.52)
  224  
  225   "BLD",1045 9,"KRN","B ",8994,899 4)
  226  
  227   "BLD",1045 9,"PRE")
  228  
  229   "BLD",1045 9,"QDEF")
  230   ^^^^NO^^^^ YES^^NO
  231   "BLD",1045 9,"QUES",0 )
  232   ^9.62^^
  233   "BLD",1045 9,"REQB",0 )
  234   ^9.611^^0
  235   "DATA",200 ,520824643 ,0)
  236   INTERFACE, IB EIV^EIV ^^N
  237   "DATA",200 ,520824643 ,.1)
  238   ^^^^^^^^^^
  239   "DATA",200 ,520824643 ,1)
  240   ^^^^^^3170 222^520824 634
  241   "DATA",200 ,520824643 ,3.1)
  242   2259767
  243   "DATA",200 ,520824643 ,20)
  244   ^IB EIV IN TERFACE^IB  EIV INTER FACE
  245   "FIA",200)
  246   NEW PERSON
  247   "FIA",200, 0)
  248   ^VA(200,
  249   "FIA",200, 0,0)
  250   200Is
  251   "FIA",200, 0,1)
  252   y^n^f^^n^^ y^m^n
  253   "FIA",200, 0,10)
  254  
  255   "FIA",200, 0,11)
  256   I $$INC200 ^IBY582PR( Y)
  257   "FIA",200, 0,"RLRO")
  258  
  259   "FIA",200, 0,"VR")
  260   2.0^IB
  261   "FIA",200, 200)
  262   0
  263   "FIA",200, 200.005)
  264   0
  265   "FIA",200, 200.008983 1)
  266   0
  267   "FIA",200, 200.008983 2)
  268   0
  269   "FIA",200, 200.008983 3)
  270   0
  271   "FIA",200, 200.008983 31)
  272   0
  273   "FIA",200, 200.008983 4)
  274   0
  275   "FIA",200, 200.01)
  276   0
  277   "FIA",200, 200.010113 )
  278   0
  279   "FIA",200, 200.02)
  280   0
  281   "FIA",200, 200.03)
  282   0
  283   "FIA",200, 200.032)
  284   0
  285   "FIA",200, 200.0351)
  286   0
  287   "FIA",200, 200.04)
  288   0
  289   "FIA",200, 200.042)
  290   0
  291   "FIA",200, 200.05)
  292   0
  293   "FIA",200, 200.051)
  294   0
  295   "FIA",200, 200.052)
  296   0
  297   "FIA",200, 200.06)
  298   0
  299   "FIA",200, 200.07)
  300   0
  301   "FIA",200, 200.072)
  302   0
  303   "FIA",200, 200.074)
  304   0
  305   "FIA",200, 200.19)
  306   0
  307   "FIA",200, 200.194)
  308   0
  309   "FIA",200, 200.196)
  310   0
  311   "FIA",200, 200.198)
  312   0
  313   "FIA",200, 200.1981)
  314   0
  315   "FIA",200, 200.541)
  316   0
  317   "FIA",200, 200.55)
  318   0
  319   "FIA",200, 200.72)
  320   0
  321   "IX",200,2 00,"ADEG", 0)
  322   200^ADEG^U pdate the  DEGREE fie ld in the  Name Compo nents file .^MU^^F^IR ^I^200^^^^ ^A
  323   "IX",200,2 00,"ADEG", .1,0)
  324   ^^2^2^3000 105^^
  325   "IX",200,2 00,"ADEG", .1,1,0)
  326   This cross -reference  keeps the  DEGREE fi eld in the  New Perso n file in
  327   "IX",200,2 00,"ADEG", .1,2,0)
  328   synch with  the DEGRE E field in  the Name  Components  file.
  329   "IX",200,2 00,"ADEG", 1)
  330   I '$G(XUNO DEGT),X2(1 )]"" N XUN ODEGT,XUPV AL,DIERR,X UFDA,XUMSG  S XUPVAL= $P($G(^VA( 200,DA,3.1 )),U) I XU PVAL S XUN ODEGT=1,XU FDA(20,XUP VAL_",",6) =X D FILE^ DIE("","XU FDA","XUMS G")
  331   "IX",200,2 00,"ADEG", 2)
  332   I '$G(XUNO DEGT),X2(1 )="" N XUN ODEGT,XUPV AL,DIERR,X UFDA,XUMSG  S XUPVAL= $P($G(^VA( 200,DA,3.1 )),U) I XU PVAL S XUN ODEGT=1,XU FDA(20,XUP VAL_",",6) ="@" D FIL E^DIE(""," XUFDA","XU MSG")
  333   "IX",200,2 00,"ADEG", 11.1,0)
  334   ^.114IA^1^ 1
  335   "IX",200,2 00,"ADEG", 11.1,1,0)
  336   1^F^200^10 .6^^1^F
  337   "IX",200,2 00,"ANAME" ,0)
  338   200^ANAME^ Update the  correspon ding entry  in the Na me Compone nts file.^ MU^^F^IR^I ^200^^^^^A
  339   "IX",200,2 00,"ANAME" ,.1,0)
  340   ^^13^13^29 91228^
  341   "IX",200,2 00,"ANAME" ,.1,1,0)
  342   This MUMPS  cross-ref erence kee ps the Nam e field in  the New P erson file  in
  343   "IX",200,2 00,"ANAME" ,.1,2,0)
  344   synch with  the corre sponding e ntry in th e Name Com ponents fi le (#20).
  345   "IX",200,2 00,"ANAME" ,.1,3,0)
  346    
  347   "IX",200,2 00,"ANAME" ,.1,4,0)
  348   The XUNOTR IG flag co ntrols whe ther this  cross-refe rence is e xecuted. T he
  349   "IX",200,2 00,"ANAME" ,.1,5,0)
  350   form XUEXI STING USER  and the X UNEW USER  forms both  set the X UNOTRIG fl ag,
  351   "IX",200,2 00,"ANAME" ,.1,6,0)
  352   because th e forms th emselves c ontain the  logic nec essary to  keep the t wo
  353   "IX",200,2 00,"ANAME" ,.1,7,0)
  354   files in s ynch.
  355   "IX",200,2 00,"ANAME" ,.1,8,0)
  356    
  357   "IX",200,2 00,"ANAME" ,.1,9,0)
  358   XUITNAME i s set by t he XUEXIST ING USER a nd XUNEW U SER forms  and is che cked
  359   "IX",200,2 00,"ANAME" ,.1,10,0)
  360   by the inp ut transfo rm on the  .01 field.  If XUITNA ME is set,  the input
  361   "IX",200,2 00,"ANAME" ,.1,11,0)
  362   transform  returns in  the XLFNC  array the  component  parts of  the name.  This
  363   "IX",200,2 00,"ANAME" ,.1,12,0)
  364   MUMPS cros s-referenc e can then  get the n ame compon ents from  the XLFNC
  365   "IX",200,2 00,"ANAME" ,.1,13,0)
  366   array to p opulate th e Name Com ponents fi le.
  367   "IX",200,2 00,"ANAME" ,1)
  368   I '$G(XUNO TRIG),X2(1 )]"" N XUN OTRIG,XUPV AL S XUNOT RIG=1,XUPV AL=$P($G(^ VA(200,DA, 3.1)),U) K :'$D(XUITN AME) XLFNC  S:$D(XLFN C)<2 XLFNC =X2(1) D U PDCOMP^XLF NAME2(200, DA,.01,.XL FNC,10.1,X UPVAL) K X LFNC,XUITN AME
  369   "IX",200,2 00,"ANAME" ,2)
  370   I '$G(XUNO TRIG),X2(1 )="" N XUN OTRIG S XU NOTRIG=1 D  DELCOMP^X LFNAME2(20 0,DA,.01)
  371   "IX",200,2 00,"ANAME" ,11.1,0)
  372   ^.114IA^1^ 1
  373   "IX",200,2 00,"ANAME" ,11.1,1,0)
  374   1^F^200^.0 1^^1^F
  375   "IX",200,2 00,"AOIUID ",0)
  376   200^AOIUID ^This is a  regular i ndex of OI D+UID (205 .3+205.4)^ R^^R^IR^I^ 200^^^^^S
  377   "IX",200,2 00,"AOIUID ",.1,0)
  378   ^^4^4^3150 112^
  379   "IX",200,2 00,"AOIUID ",.1,1,0)
  380   The combin ation of t he SUBJECT  ORGANIZAT ION ID fie ld (#205.3 ) and the 
  381   "IX",200,2 00,"AOIUID ",.1,2,0)
  382   UNIQUE USE R ID field  (#205.4)  creates a  unique ide ntifier wh en used to  
  383   "IX",200,2 00,"AOIUID ",.1,3,0)
  384   identify e xternal us ers such a s those fr om non-VA  organizati ons that h ave
  385   "IX",200,2 00,"AOIUID ",.1,4,0)
  386   some conne ction with  a patient  record.
  387   "IX",200,2 00,"AOIUID ",1)
  388   S ^VA(200, "AOIUID",$ E(X(1),1,3 0),$E(X(2) ,1,30),DA) =""
  389   "IX",200,2 00,"AOIUID ",2)
  390   K ^VA(200, "AOIUID",$ E(X(1),1,3 0),$E(X(2) ,1,30),DA)
  391   "IX",200,2 00,"AOIUID ",2.5)
  392   K ^VA(200, "AOIUID")
  393   "IX",200,2 00,"AOIUID ",11.1,0)
  394   ^.114IA^2^ 2
  395   "IX",200,2 00,"AOIUID ",11.1,1,0 )
  396   1^F^200^20 5.3^30^1^F
  397   "IX",200,2 00,"AOIUID ",11.1,2,0 )
  398   2^F^200^20 5.4^30^2^F
  399   "IX",200,2 00,"ATR",0 )
  400   200^ATR^Th is index k eeps track  of record s for whic h clinical  trainee d ata is edi ted.^MU^^R ^IR^I^200^ ^^^^S
  401   "IX",200,2 00,"ATR",. 1,0)
  402   ^^20^20^30 40927^
  403   "IX",200,2 00,"ATR",. 1,1,0)
  404   This new-s tyle cross -reference  has as cr oss-refere nce values  all the 
  405   "IX",200,2 00,"ATR",. 1,2,0)
  406   fields in  the NEW PE RSON file  that are b eing track ed by the  Office of 
  407   "IX",200,2 00,"ATR",. 1,3,0)
  408   Academic A ffiliation s for roll up into a  centralize d database . When any  of
  409   "IX",200,2 00,"ATR",. 1,4,0)
  410   the fields  are edite d, the cro ss-referen ce logic w ill set an  index ent ry
  411   "IX",200,2 00,"ATR",. 1,5,0)
  412   that corre sponds to  the edited  record. T he index e ntries wil l look lik e
  413   "IX",200,2 00,"ATR",. 1,6,0)
  414   this:
  415   "IX",200,2 00,"ATR",. 1,7,0)
  416    
  417   "IX",200,2 00,"ATR",. 1,8,0)
  418     ^VA(200, "ATR",ien)  = FM inte rnal date
  419   "IX",200,2 00,"ATR",. 1,9,0)
  420    
  421   "IX",200,2 00,"ATR",. 1,10,0)
  422   "ATR" stan ds for "AT Rainee." 
  423   "IX",200,2 00,"ATR",. 1,11,0)
  424    
  425   "IX",200,2 00,"ATR",. 1,12,0)
  426   None of th e field-ty pe cross-r eference v alues are  used as su bscripts i n
  427   "IX",200,2 00,"ATR",. 1,13,0)
  428   the index,  since we  are only i nterested  in recordi ng the IEN s of the
  429   "IX",200,2 00,"ATR",. 1,14,0)
  430   records th at are edi ted and th e date the  index ent ry is set.  A separat e
  431   "IX",200,2 00,"ATR",. 1,15,0)
  432   queuable o ption will  loop thro ugh the en tries in t his index,  and send  via
  433   "IX",200,2 00,"ATR",. 1,16,0)
  434   HL7 messag es the cli nical trai nee data o f each rec ord to the  Office of
  435   "IX",200,2 00,"ATR",. 1,17,0)
  436   Academic A ffiliation s.
  437   "IX",200,2 00,"ATR",. 1,18,0)
  438    
  439   "IX",200,2 00,"ATR",. 1,19,0)
  440   Note that  the index  will only  be set if  the person  is a Clin ical Train ee,
  441   "IX",200,2 00,"ATR",. 1,20,0)
  442   that is, i f the PROG RAM OF STU DY (#12.2)  field is  filled in.
  443   "IX",200,2 00,"ATR",1 )
  444   S ^VA(200, "ATR",DA)= $G(DT)
  445   "IX",200,2 00,"ATR",1 .4)
  446   S X=X1(11) !X2(11)
  447   "IX",200,2 00,"ATR",2 )
  448   K ^VA(200, "ATR",DA)
  449   "IX",200,2 00,"ATR",2 .4)
  450  
  451   "IX",200,2 00,"ATR",2 .5)
  452   K ^VA(200, "ATR")
  453   "IX",200,2 00,"ATR",1 1.1,0)
  454   ^.114IA^21 ^19
  455   "IX",200,2 00,"ATR",1 1.1,2,0)
  456   1^F^200^.0 1^^^
  457   "IX",200,2 00,"ATR",1 1.1,3,0)
  458   2^F^200^.1 11^^^
  459   "IX",200,2 00,"ATR",1 1.1,4,0)
  460   3^F^200^.1 12^^^
  461   "IX",200,2 00,"ATR",1 1.1,5,0)
  462   4^F^200^.1 13^^^
  463   "IX",200,2 00,"ATR",1 1.1,6,0)
  464   5^F^200^.1 14^^^
  465   "IX",200,2 00,"ATR",1 1.1,7,0)
  466   6^F^200^.1 15^^^^
  467   "IX",200,2 00,"ATR",1 1.1,8,0)
  468   7^F^200^.1 16^^^
  469   "IX",200,2 00,"ATR",1 1.1,9,0)
  470   8^F^200^9^ ^^
  471   "IX",200,2 00,"ATR",1 1.1,10,0)
  472   9^F^200^.1 51^^^
  473   "IX",200,2 00,"ATR",1 1.1,11,0)
  474   10^F^200^1 2.1^^^
  475   "IX",200,2 00,"ATR",1 1.1,12,0)
  476   11^F^200^1 2.2^^^
  477   "IX",200,2 00,"ATR",1 1.1,13,0)
  478   12^F^200^1 2.3^^^^
  479   "IX",200,2 00,"ATR",1 1.1,14,0)
  480   13^F^200^2 9^^^
  481   "IX",200,2 00,"ATR",1 1.1,15,0)
  482   14^F^200^8 ^^^
  483   "IX",200,2 00,"ATR",1 1.1,17,0)
  484   16^F^200^5 ^^^
  485   "IX",200,2 00,"ATR",1 1.1,18,0)
  486   17^F^200^1 2.4^^^
  487   "IX",200,2 00,"ATR",1 1.1,19,0)
  488   18^F^200^1 2.6^^^F
  489   "IX",200,2 00,"ATR",1 1.1,20,0)
  490   19^F^200^1 2.7^^^F
  491   "IX",200,2 00,"ATR",1 1.1,21,0)
  492   20^F^200^1 2.8^^^F
  493   "IX",200,2 00,"AUSER" ,0)
  494   200^AUSER^ Build cros s referenc e of activ e users^MU ^^R^IR^I^2 00^^^^^S
  495   "IX",200,2 00,"AUSER" ,.1,0)
  496   ^^4^4^3060 606
  497   "IX",200,2 00,"AUSER" ,.1,1,0)
  498   This is a  cross refe rence of C PRS Active  USERs (AU SER):
  499   "IX",200,2 00,"AUSER" ,.1,2,0)
  500    
  501   "IX",200,2 00,"AUSER" ,.1,3,0)
  502    The cross  reference  is in the  format:
  503   "IX",200,2 00,"AUSER" ,.1,4,0)
  504    ^VA(200," AUSER",<NA ME(#.01) v alue>,IEN) =""
  505   "IX",200,2 00,"AUSER" ,1)
  506   I DA'<1,$$ PROVIDER^X USER(DA),X (1)]"",X(3 )<1 S ^VA( 200,"AUSER ",X(1),DA) ="" Q
  507   "IX",200,2 00,"AUSER" ,1.4)
  508   Q
  509   "IX",200,2 00,"AUSER" ,2)
  510   I ((DA'<1& X1(1)'=X2( 1))!(DA'<1 &X2(2)="") ) K ^VA(20 0,"AUSER", X1(1),DA)
  511   "IX",200,2 00,"AUSER" ,2.4)
  512   Q
  513   "IX",200,2 00,"AUSER" ,2.5)
  514   K ^VA(200, "AUSER")
  515   "IX",200,2 00,"AUSER" ,11.1,0)
  516   ^.114IA^3^ 3
  517   "IX",200,2 00,"AUSER" ,11.1,1,0)
  518   1^F^200^.0 1^^^F
  519   "IX",200,2 00,"AUSER" ,11.1,2,0)
  520   2^F^200^2^ ^^F
  521   "IX",200,2 00,"AUSER" ,11.1,3,0)
  522   3^F^200^7^ ^^F
  523   "IX",200,2 00,"AUSERK EY",0)
  524   200^AUSERK EY^Index t o monitor  the Alloca tion/De-al location o f the XUOR ES Securit y Key.^MU^ ^F^IR^W^20 0.051^^^^^ S
  525   "IX",200,2 00,"AUSERK EY",1)
  526   I $$PROVID ER^XUSER(D A(1)) S ^V A(200,"AUS ER",$P(^VA (200,DA(1) ,0),U),DA( 1))=""
  527   "IX",200,2 00,"AUSERK EY",2)
  528   I '$$PROVI DER^XUSER( DA(1)) K ^ VA(200,"AU SER",$P(^V A(200,DA(1 ),0),U),DA (1))
  529   "IX",200,2 00,"AUSERK EY",2.5)
  530   Q
  531   "IX",200,2 00,"AUSERK EY",11.1,0 )
  532   ^.114IA^1^ 1
  533   "IX",200,2 00,"AUSERK EY",11.1,1 ,0)
  534   1^F^200.05 1^.01^^^F
  535   "IX",200,2 00,"AVISIT ",0)
  536   200^AVISIT ^This is a  regular i ndex of th e remote D UZ and Sta tion numbe r.^R^^R^IR ^W^200.06^ ^^^^S
  537   "IX",200,2 00,"AVISIT ",1)
  538   S ^VA(200, "AVISIT",$ E(X(1),1,3 0),$E(X(2) ,1,15),DA( 1),DA)=""
  539   "IX",200,2 00,"AVISIT ",2)
  540   K ^VA(200, "AVISIT",$ E(X(1),1,3 0),$E(X(2) ,1,15),DA( 1),DA)
  541   "IX",200,2 00,"AVISIT ",2.5)
  542   K ^VA(200, "AVISIT")
  543   "IX",200,2 00,"AVISIT ",11.1,0)
  544   ^.114IA^2^ 2
  545   "IX",200,2 00,"AVISIT ",11.1,1,0 )
  546   1^F^200.06 ^.01^30^1^ F
  547   "IX",200,2 00,"AVISIT ",11.1,2,0 )
  548   2^F^200.06 ^2^15^2^F
  549   "IX",200,2 00,"AXUHUI ",0)
  550   200^AXUHUI ^Hui Proje ct Top Fil e Xref^MU^ ^R^^I^200^ ^^^^A
  551   "IX",200,2 00,"AXUHUI ",.1,0)
  552   ^^8^8^3020 528^
  553   "IX",200,2 00,"AXUHUI ",.1,1,0)
  554   This new s tyle cross -reference  is on non -multiple  fields tha t the Hui
  555   "IX",200,2 00,"AXUHUI ",.1,2,0)
  556   project wa nt to moni tor for a  change in  value (Pat ch XU*8*23 6). The
  557   "IX",200,2 00,"AXUHUI ",.1,3,0)
  558   following  fields are  being mon itored in  order:
  559   "IX",200,2 00,"AXUHUI ",.1,4,0)
  560    
  561   "IX",200,2 00,"AXUHUI ",.1,5,0)
  562    .01 (NAME )
  563   "IX",200,2 00,"AXUHUI ",.1,6,0)
  564    9.2 (TERM INATION DA TE)
  565   "IX",200,2 00,"AXUHUI ",.1,7,0)
  566    5 (DOB)
  567   "IX",200,2 00,"AXUHUI ",.1,8,0)
  568    9 (SSN) 
  569   "IX",200,2 00,"AXUHUI ",1)
  570   D HUI^XUHU I("","XUHU I FIELD CH ANGE EVENT ","","AXUH UI") Q
  571   "IX",200,2 00,"AXUHUI ",2)
  572   Q
  573   "IX",200,2 00,"AXUHUI ",2.5)
  574   Q
  575   "IX",200,2 00,"AXUHUI ",11.1,0)
  576   ^.114IA^4^ 4
  577   "IX",200,2 00,"AXUHUI ",11.1,1,0 )
  578   1^F^200^.0 1^^^F
  579   "IX",200,2 00,"AXUHUI ",11.1,2,0 )
  580   2^F^200^9. 2^^^F
  581   "IX",200,2 00,"AXUHUI ",11.1,3,0 )
  582   3^F^200^5^ ^^F
  583   "IX",200,2 00,"AXUHUI ",11.1,4,0 )
  584   4^F^200^9^ ^^F
  585   "IX",200,2 00,"AXUHUI KEY",0)
  586   200^AXUHUI KEY^HUI ke y xref^MU^ ^R^^W^200. 051^^^^^A
  587   "IX",200,2 00,"AXUHUI KEY",.1,0)
  588   ^^3^3^3021 011
  589   "IX",200,2 00,"AXUHUI KEY",.1,1, 0)
  590   This new s tyle cross -reference  is on the  multiple:  'KEYS' so  the Hui
  591   "IX",200,2 00,"AXUHUI KEY",.1,2, 0)
  592   project ca n monitor  the alloca tion/de-al location o f the 'PRO VIDER'
  593   "IX",200,2 00,"AXUHUI KEY",.1,3, 0)
  594   key.
  595   "IX",200,2 00,"AXUHUI KEY",1)
  596   D HUIKEY^X UHUI("","X UHUI FIELD  CHANGE EV ENT","","A XUHUIKEY")  Q
  597   "IX",200,2 00,"AXUHUI KEY",2)
  598   D HUIKEY^X UHUI("","X UHUI FIELD  CHANGE EV ENT","K"," AXUHUIKEY" ) Q
  599   "IX",200,2 00,"AXUHUI KEY",2.5)
  600   Q
  601   "IX",200,2 00,"AXUHUI KEY",11.1, 0)
  602   ^.114IA^1^ 1
  603   "IX",200,2 00,"AXUHUI KEY",11.1, 1,0)
  604   1^F^200.05 1^.01^^^F
  605   "IX",200,2 00,"B",0)
  606   200^B^Regu lar "B" in dex on .01  field wit h transfor m, length  35.^R^^F^I R^I^200^^^ ^^LS
  607   "IX",200,2 00,"B",1)
  608   S ^VA(200, "B",$E(X,1 ,35),DA)=" "
  609   "IX",200,2 00,"B",2)
  610   K ^VA(200, "B",$E(X,1 ,35),DA)
  611   "IX",200,2 00,"B",2.5 )
  612   K ^VA(200, "B")
  613   "IX",200,2 00,"B",11. 1,0)
  614   ^.114IA^1^ 1
  615   "IX",200,2 00,"B",11. 1,1,0)
  616   1^F^200^.0 1^35^1^F
  617   "IX",200,2 00,"B",11. 1,1,4)
  618   N XLFNAME  S XLFNAME= X S X=$$FO RMAT^XLFNA ME7(.XLFNA ME,3,35,,0 )
  619   "IX",200,2 00,"NPI42" ,0)
  620   200^NPI42^ NPI42 X-RE F^R^^F^IR^ W^200.042^ ^^^^LS
  621   "IX",200,2 00,"NPI42" ,1)
  622   S ^VA(200, "NPI42",$E (X,1,10),D A(1),DA)=" "
  623   "IX",200,2 00,"NPI42" ,2)
  624   K ^VA(200, "NPI42",$E (X,1,10),D A(1),DA)
  625   "IX",200,2 00,"NPI42" ,2.5)
  626   K ^VA(200, "NPI42")
  627   "IX",200,2 00,"NPI42" ,11.1,0)
  628   ^.114IA^1^ 1
  629   "IX",200,2 00,"NPI42" ,11.1,1,0)
  630   1^F^200.04 2^.03^10^1 ^F
  631   "KRN",3.8, 1200,-1)
  632   0^1
  633   "KRN",3.8, 1200,0)
  634   IBCNE EIV  MESSAGE^PU ^y^^^^
  635   "KRN",3.8, 1200,2,0)
  636   ^3.801^2^2 ^3170308^^ ^^
  637   "KRN",3.8, 1200,2,1,0 )
  638   This mail  group will  be used t o deliver  notificati ons for
  639   "KRN",3.8, 1200,2,2,0 )
  640   the Insura nce Verifi cation pro cess.
  641   "KRN",3.8, 1200,3)
  642  
  643   "KRN",101, 4384,-1)
  644   0^1
  645   "KRN",101, 4384,0)
  646   IBJT NS VI EW EXP POL  MENU^Poli cy Menu^^M ^^^^^^^^IN TEGRATED B ILLING
  647   "KRN",101, 4384,4)
  648   26^4
  649   "KRN",101, 4384,10,0)
  650   ^101.01PA^ 16^15
  651   "KRN",101, 4384,10,1, 0)
  652   4412^BC^11 0^
  653   "KRN",101, 4384,10,1, "^")
  654   IBJT BILL  CHARGES SC REEN
  655   "KRN",101, 4384,10,2, 0)
  656   4413^DX^12 0^
  657   "KRN",101, 4384,10,2, "^")
  658   IBJT BILL  DX SCREEN
  659   "KRN",101, 4384,10,3, 0)
  660   4414^PR^13 0^
  661   "KRN",101, 4384,10,3, "^")
  662   IBJT BILL  PROCEDURES  SCREEN
  663   "KRN",101, 4384,10,4, 0)
  664   4421^CI^14 0^
  665   "KRN",101, 4384,10,4, "^")
  666   IBJT CLAIM  SCREEN SK IP
  667   "KRN",101, 4384,10,5, 0)
  668   4415^AR^21 0^
  669   "KRN",101, 4384,10,5, "^")
  670   IBJT AR AC COUNT PROF ILE SCREEN
  671   "KRN",101, 4384,10,6, 0)
  672   4427^CM^22 0^
  673   "KRN",101, 4384,10,6, "^")
  674   IBJT AR CO MMENT HIST ORY SCREEN
  675   "KRN",101, 4384,10,7, 0)
  676   4424^IR^23 0^
  677   "KRN",101, 4384,10,7, "^")
  678   IBJT CT/IR  COMMUNICA TIONS LIST  SCREEN
  679   "KRN",101, 4384,10,8, 0)
  680   4426^HS^24 0^
  681   "KRN",101, 4384,10,8, "^")
  682   IBJT HS HE ALTH SUMMA RY
  683   "KRN",101, 4384,10,9, 0)
  684   4418^AL^15 0^
  685   "KRN",101, 4384,10,9, "^")
  686   IBJT ACTIV E LIST SCR EEN SKIP
  687   "KRN",101, 4384,10,10 ,0)
  688   4409^VI^31 0^
  689   "KRN",101, 4384,10,10 ,"^")
  690   IBJT NS VI EW INS CO  SCREEN
  691   "KRN",101, 4384,10,11 ,0)
  692   4430^VP^32 0^
  693   "KRN",101, 4384,10,11 ,"^")
  694   IBJT NS VI EW EXP POL  REDISPLAY
  695   "KRN",101, 4384,10,12 ,0)
  696   4411^AB^33 0^
  697   "KRN",101, 4384,10,12 ,"^")
  698   IBJT NS VI EW AN BEN  SCREEN
  699   "KRN",101, 4384,10,13 ,0)
  700   4423^EL^34 0^
  701   "KRN",101, 4384,10,13 ,"^")
  702   IBJT PT EL IGIBILITY  SCREEN
  703   "KRN",101, 4384,10,15 ,0)
  704   8132^PT^25 0^
  705   "KRN",101, 4384,10,15 ,"^")
  706   IBJT PATIE NT POLICY  COMMENTS V IEW
  707   "KRN",101, 4384,10,16 ,0)
  708   4404^EX^35 0^
  709   "KRN",101, 4384,10,16 ,"^")
  710   IBJ EXIT
  711   "KRN",101, 4384,15)
  712   I $G(IBPRV SCR)'="IBC NSVP",$G(I BFASTXT)>2  S VALMBCK ="Q"
  713   "KRN",101, 4384,20)
  714   K IBFASTXT
  715   "KRN",101, 4384,26)
  716   D BM^IBJU1 (21,17),SH OW^VALM
  717   "KRN",101, 4384,28)
  718   Select Act ion: 
  719   "KRN",101, 4384,99)
  720   64335,5189 1
  721   "KRN",101, 4404,-1)
  722   4^3
  723   "KRN",101, 4404,0)
  724   IBJ EXIT
  725   "KRN",101, 4409,-1)
  726   4^13
  727   "KRN",101, 4409,0)
  728   IBJT NS VI EW INS CO  SCREEN
  729   "KRN",101, 4411,-1)
  730   4^15
  731   "KRN",101, 4411,0)
  732   IBJT NS VI EW AN BEN  SCREEN
  733   "KRN",101, 4412,-1)
  734   4^4
  735   "KRN",101, 4412,0)
  736   IBJT BILL  CHARGES SC REEN
  737   "KRN",101, 4413,-1)
  738   4^5
  739   "KRN",101, 4413,0)
  740   IBJT BILL  DX SCREEN
  741   "KRN",101, 4414,-1)
  742   4^6
  743   "KRN",101, 4414,0)
  744   IBJT BILL  PROCEDURES  SCREEN
  745   "KRN",101, 4415,-1)
  746   4^8
  747   "KRN",101, 4415,0)
  748   IBJT AR AC COUNT PROF ILE SCREEN
  749   "KRN",101, 4418,-1)
  750   4^12
  751   "KRN",101, 4418,0)
  752   IBJT ACTIV E LIST SCR EEN SKIP
  753   "KRN",101, 4421,-1)
  754   4^7
  755   "KRN",101, 4421,0)
  756   IBJT CLAIM  SCREEN SK IP
  757   "KRN",101, 4423,-1)
  758   4^16
  759   "KRN",101, 4423,0)
  760   IBJT PT EL IGIBILITY  SCREEN
  761   "KRN",101, 4424,-1)
  762   4^10
  763   "KRN",101, 4424,0)
  764   IBJT CT/IR  COMMUNICA TIONS LIST  SCREEN
  765   "KRN",101, 4426,-1)
  766   4^11
  767   "KRN",101, 4426,0)
  768   IBJT HS HE ALTH SUMMA RY
  769   "KRN",101, 4427,-1)
  770   4^9
  771   "KRN",101, 4427,0)
  772   IBJT AR CO MMENT HIST ORY SCREEN
  773   "KRN",101, 4430,-1)
  774   4^14
  775   "KRN",101, 4430,0)
  776   IBJT NS VI EW EXP POL  REDISPLAY
  777   "KRN",101, 8132,-1)
  778   4^2
  779   "KRN",101, 8132,0)
  780   IBJT PATIE NT POLICY  COMMENTS V IEW
  781   "MBREQ")
  782   0
  783   "ORD",11,3 .8)
  784   3.8;11;;;M AILG^XPDTA 1;MAILGF1^ XPDIA1;MAI LGE1^XPDIA 1;MAILGF2^ XPDIA1;;MA ILGDEL^XPD IA1(%)
  785   "ORD",11,3 .8,0)
  786   MAIL GROUP
  787   "ORD",15,1 01)
  788   101;15;;;P RO^XPDTA;P ROF1^XPDIA ;PROE1^XPD IA;PROF2^X PDIA;;PROD EL^XPDIA
  789   "ORD",15,1 01,0)
  790   PROTOCOL
  791   "PKG",230, -1)
  792   1^1
  793   "PKG",230, 0)
  794   INTEGRATED  BILLING^I B^INTEGRAT ED BILLING
  795   "PKG",230, 20,0)
  796   ^9.402P^1^ 1
  797   "PKG",230, 20,1,0)
  798   2^^IBAXDR
  799   "PKG",230, 20,1,1)
  800  
  801   "PKG",230, 20,"B",2,1 )
  802  
  803   "PKG",230, 22,0)
  804   ^9.49I^1^1
  805   "PKG",230, 22,1,0)
  806   2.0^294032 1^2940525
  807   "PKG",230, 22,1,"PAH" ,1,0)
  808   582^317032 0
  809   "QUES","XP F1",0)
  810   Y
  811   "QUES","XP F1","??")
  812   ^D REP^XPD H
  813   "QUES","XP F1","A")
  814   Shall I wr ite over y our |FLAG|  File
  815   "QUES","XP F1","B")
  816   YES
  817   "QUES","XP F1","M")
  818   D XPF1^XPD IQ
  819   "QUES","XP F2",0)
  820   Y
  821   "QUES","XP F2","??")
  822   ^D DTA^XPD H
  823   "QUES","XP F2","A")
  824   Want my da ta |FLAG|  yours
  825   "QUES","XP F2","B")
  826   YES
  827   "QUES","XP F2","M")
  828   D XPF2^XPD IQ
  829   "QUES","XP I1",0)
  830   YO
  831   "QUES","XP I1","??")
  832   ^D INHIBIT ^XPDH
  833   "QUES","XP I1","A")
  834   Want KIDS  to INHIBIT  LOGONs du ring the i nstall
  835   "QUES","XP I1","B")
  836   NO
  837   "QUES","XP I1","M")
  838   D XPI1^XPD IQ
  839   "QUES","XP M1",0)
  840   PO^VA(200, :EM
  841   "QUES","XP M1","??")
  842   ^D MG^XPDH
  843   "QUES","XP M1","A")
  844   Enter the  Coordinato r for Mail  Group '|F LAG|'
  845   "QUES","XP M1","B")
  846  
  847   "QUES","XP M1","M")
  848   D XPM1^XPD IQ
  849   "QUES","XP O1",0)
  850   Y
  851   "QUES","XP O1","??")
  852   ^D MENU^XP DH
  853   "QUES","XP O1","A")
  854   Want KIDS  to Rebuild  Menu Tree s Upon Com pletion of  Install
  855   "QUES","XP O1","B")
  856   YES
  857   "QUES","XP O1","M")
  858   D XPO1^XPD IQ
  859   "QUES","XP Z1",0)
  860   Y
  861   "QUES","XP Z1","??")
  862   ^D OPT^XPD H
  863   "QUES","XP Z1","A")
  864   Want to DI SABLE Sche duled Opti ons, Menu  Options, a nd Protoco ls
  865   "QUES","XP Z1","B")
  866   NO
  867   "QUES","XP Z1","M")
  868   D XPZ1^XPD IQ
  869   "QUES","XP Z2",0)
  870   Y
  871   "QUES","XP Z2","??")
  872   ^D RTN^XPD H
  873   "QUES","XP Z2","A")
  874   Want to MO VE routine s to other  CPUs
  875   "QUES","XP Z2","B")
  876   NO
  877   "QUES","XP Z2","M")
  878   D XPZ2^XPD IQ
  879   "RTN")
  880   7
  881   "RTN","IBC NCH")
  882   0^10^B8993 0546^B8993 0576
  883   "RTN","IBC NCH",1,0)
  884   IBCNCH ;AL B/FA - PAT IENT POLIC Y COMMENT  HISTORY ;0 5-MAR-2015
  885   "RTN","IBC NCH",2,0)
  886    ;;2.0;INT EGRATED BI LLING;**54 9,582**;21 -MAR-94;Bu ild 77
  887   "RTN","IBC NCH",3,0)
  888    ;;Per VA  Directive  6402, this  routine s hould not  be modifie d.
  889   "RTN","IBC NCH",4,0)
  890    ;
  891   "RTN","IBC NCH",5,0)
  892   EN(DFN,IBI IEN,MODE)  ;EP 
  893   "RTN","IBC NCH",6,0)
  894    ; Main en try point
  895   "RTN","IBC NCH",7,0)
  896    ; Input:    DFN      - IEN of t he patient
  897   "RTN","IBC NCH",8,0)
  898    ;           IBIIEN   - IEN of p atient pol icy multip le (^DPT(D FN,.312,IB IIEN)
  899   "RTN","IBC NCH",9,0)
  900    ;           MODE     - 1 - User  is allowe d to Add/E dit/Delete /View/Sear ch comment s
  901   "RTN","IBC NCH",10,0)
  902    ;                      0 - User  is allowe d to View/ Search com ments
  903   "RTN","IBC NCH",11,0)
  904    K VALMQUI T
  905   "RTN","IBC NCH",12,0)
  906    I $G(DFN) ="" D  Q
  907   "RTN","IBC NCH",13,0)
  908    . W !!,*7 ,"Patient  is not ide ntified."
  909   "RTN","IBC NCH",14,0)
  910    . D PAUSE ^VALM1
  911   "RTN","IBC NCH",15,0)
  912    I +$G(IBI IEN)<0 D   Q
  913   "RTN","IBC NCH",16,0)
  914    . W !!,*7 ,"Patient  Policy is  not identi fied."
  915   "RTN","IBC NCH",17,0)
  916    . D PAUSE ^VALM1
  917   "RTN","IBC NCH",18,0)
  918    S:'$D(MOD E) MODE=0
  919   "RTN","IBC NCH",19,0)
  920    ;
  921   "RTN","IBC NCH",20,0)
  922    I MODE=1  D EN^VALM( "IBCNCH PO LICY COMME NT HISTORY ") Q
  923   "RTN","IBC NCH",21,0)
  924    D EN^VALM ("IBCNCH P OLICY COMM ENT VIEW")
  925   "RTN","IBC NCH",22,0)
  926    Q
  927   "RTN","IBC NCH",23,0)
  928    ;
  929   "RTN","IBC NCH",24,0)
  930   HDR ;EP
  931   "RTN","IBC NCH",25,0)
  932    ; Build t he listman  template  header inf ormation
  933   "RTN","IBC NCH",26,0)
  934    ; Input:    DFN      - IEN of t he patient
  935   "RTN","IBC NCH",27,0)
  936    ;           IBPPOL   - ^DPT(DFN ,.312,PIEN ,0) Where  PIEN is th e IEN of t he
  937   "RTN","IBC NCH",28,0)
  938    ;                      selected  patient p olicy
  939   "RTN","IBC NCH",29,0)
  940    N WW,XX,Y Y,ZZ
  941   "RTN","IBC NCH",30,0)
  942    S XX=$E($ P(^DPT(DFN ,0),"^",1) ,1,20)_"   "_$P($$PT^ IBEFUNC(DF N),"^",2)
  943   "RTN","IBC NCH",31,0)
  944    S ZZ=$$GE T1^DIQ(2,D FN_",",.03 ),XX=XX_"   "_ZZ
  945   "RTN","IBC NCH",32,0)
  946    S VALMHDR (1)="Polic y Comment  History fo r: "_XX
  947   "RTN","IBC NCH",33,0)
  948    S ZZ=$G(^ DPT(DFN,.3 12,+$P(IBP POL,"^",4) ,0))
  949   "RTN","IBC NCH",34,0)
  950    S WW=$P($ G(^IBA(355 .3,+$P(ZZ, "^",18),0) ),"^",11)
  951   "RTN","IBC NCH",35,0)
  952    S YY=$E($ P($G(^DIC( 36,+ZZ,0)) ,"^",1),1, 20)_" Insu rance Comp any"
  953   "RTN","IBC NCH",36,0)
  954    S XX="**  Plan Curre ntly "_$S( WW:"Ina",1 :"A")_"cti ve **"
  955   "RTN","IBC NCH",37,0)
  956    S VALMHDR (2)=$$SETS TR^VALM1(X X,YY,48,29 )
  957   "RTN","IBC NCH",38,0)
  958    Q
  959   "RTN","IBC NCH",39,0)
  960    ;
  961   "RTN","IBC NCH",40,0)
  962   INIT ;EP
  963   "RTN","IBC NCH",41,0)
  964    ; Initial ize the li stman temp late
  965   "RTN","IBC NCH",42,0)
  966    ; Input:    DFN                   - IEN of  the patie nt
  967   "RTN","IBC NCH",43,0)
  968    ;           IBIIEN                - ^DPT(D FN,.312,IB IIEN,0) Wh ere IBIIEN  is the
  969   "RTN","IBC NCH",44,0)
  970    ;                                   multip le IEN of  the select ed patient  policy
  971   "RTN","IBC NCH",45,0)
  972    ; Output:   ^TMP("IB CNCH",$J)    - Body l ines to di splay for  specified  template
  973   "RTN","IBC NCH",46,0)
  974    ;           ^TMP($J, "IBCNCHIX" ) - Index  of display ed comment s (see GET COMS)
  975   "RTN","IBC NCH",47,0)
  976    K ^TMP("I BCNCH",$J) ,^TMP($J," IBCNCHIX")
  977   "RTN","IBC NCH",48,0)
  978    D BLD^IBC NCH2(DFN,I BIIEN)
  979   "RTN","IBC NCH",49,0)
  980    Q
  981   "RTN","IBC NCH",50,0)
  982    ;
  983   "RTN","IBC NCH",51,0)
  984   ADDCOM  ;E P
  985   "RTN","IBC NCH",52,0)
  986    ; Protoco l action t o Add a ne w Patient  Policy Com ment
  987   "RTN","IBC NCH",53,0)
  988    ; Input:    DFN      - IEN of t he selecte d Patient
  989   "RTN","IBC NCH",54,0)
  990    ;           IBIIEN   - ^DPT(DFN ,.312,IBII EN,0) Wher e IBIIEN i s the
  991   "RTN","IBC NCH",55,0)
  992    ;                      multiple  IEN of th e selected  patient p olicy
  993   "RTN","IBC NCH",56,0)
  994    N COMDT,C OMIEN,DA,D IE,DR,DTOU T,XX
  995   "RTN","IBC NCH",57,0)
  996    D FULL^VA LM1
  997   "RTN","IBC NCH",58,0)
  998    S VALMBCK ="R"
  999   "RTN","IBC NCH",59,0)
  1000    ;
  1001   "RTN","IBC NCH",60,0)
  1002    ; If last  comment e ntered tod ay by this  user, edi t it inste ad of addi ng
  1003   "RTN","IBC NCH",61,0)
  1004    ; a new o ne
  1005   "RTN","IBC NCH",62,0)
  1006    S COMDT=$ O(^DPT(DFN ,.312,IBII EN,13,"B", ""),-1)
  1007   "RTN","IBC NCH",63,0)
  1008    I COMDT'= "" D
  1009   "RTN","IBC NCH",64,0)
  1010    . S COMIE N=$O(^DPT( DFN,.312,I BIIEN,13," B",COMDT," "))
  1011   "RTN","IBC NCH",65,0)
  1012    . S XX=$$ GET1^DIQ(2 .342,COMIE N_","_IBII EN_","_DFN _",",.02," I")
  1013   "RTN","IBC NCH",66,0)
  1014    I COMDT'= "",XX=DUZ, $P(COMDT," .",1)=$P($ $NOW^XLFDT (),".",1)  D  Q
  1015   "RTN","IBC NCH",67,0)
  1016    . D EDITC OM(DFN,IBI IEN,COMIEN ,0)
  1017   "RTN","IBC NCH",68,0)
  1018    ;
  1019   "RTN","IBC NCH",69,0)
  1020    ; Lock Ad ding of co mments for  this pati ent and po licy
  1021   "RTN","IBC NCH",70,0)
  1022    I '$$LOCK N(DFN,IBII EN) D  Q
  1023   "RTN","IBC NCH",71,0)
  1024    . W !!,*7 ,"Someone  else is ad ding a com ment for t his patien t and poli cy."
  1025   "RTN","IBC NCH",72,0)
  1026    . W !,"Tr y again la ter."
  1027   "RTN","IBC NCH",73,0)
  1028    . D PAUSE ^VALM1
  1029   "RTN","IBC NCH",74,0)
  1030    S COMIEN= $$NEXTCOM( DFN,IBIIEN )              ; Get  next Comme nt IEN
  1031   "RTN","IBC NCH",75,0)
  1032    ;
  1033   "RTN","IBC NCH",76,0)
  1034    ; Let the  user add  the commen t
  1035   "RTN","IBC NCH",77,0)
  1036    S DIE="^D PT(DFN,.31 2,IBIIEN,1 3,"
  1037   "RTN","IBC NCH",78,0)
  1038    S DA=COMI EN,DA(1)=I BIIEN,DA(2 )=DFN
  1039   "RTN","IBC NCH",79,0)
  1040    S DR=".04 Person Con tacted;.05 Contact Pe rson Phone ;.07Contac t Method"
  1041   "RTN","IBC NCH",80,0)
  1042    S DR=DR_" ;.06Call R eference N umber;.08A uthorizati on Number; .03Comment "
  1043   "RTN","IBC NCH",81,0)
  1044    D ^DIE
  1045   "RTN","IBC NCH",82,0)
  1046    ;
  1047   "RTN","IBC NCH",83,0)
  1048    ; Check t o make sur e a commen t was actu ally enter ed
  1049   "RTN","IBC NCH",84,0)
  1050    I $$DELCO M(DFN,IBII EN,COMIEN)  D  Q
  1051   "RTN","IBC NCH",85,0)
  1052    . W !!,*7 ,"No Comme nt was ent ered.  Not hing Filed "
  1053   "RTN","IBC NCH",86,0)
  1054    . D PAUSE ^VALM1
  1055   "RTN","IBC NCH",87,0)
  1056    . D UNLOC KN(DFN,IBI IEN)
  1057   "RTN","IBC NCH",88,0)
  1058    ;
  1059   "RTN","IBC NCH",89,0)
  1060    D UNLOCKN (DFN,IBIIE N)
  1061   "RTN","IBC NCH",90,0)
  1062    D INIT                                         ; Rebu ild the li st
  1063   "RTN","IBC NCH",91,0)
  1064    Q
  1065   "RTN","IBC NCH",92,0)
  1066    ;
  1067   "RTN","IBC NCH",93,0)
  1068   NEXTCOM(DF N,IBIIEN)  ; Get the  next avail able Patie nt Policy  Comment IE N for
  1069   "RTN","IBC NCH",94,0)
  1070    ; the sel ected Pati ent and Po licy
  1071   "RTN","IBC NCH",95,0)
  1072    ; Input:    DFN      - IEN of t he selecte d Patient
  1073   "RTN","IBC NCH",96,0)
  1074    ;           IBIIEN   - ^DPT(DFN ,.312,IBII EN,0) Wher e IBIIEN i s the
  1075   "RTN","IBC NCH",97,0)
  1076    ;                      multiple  IEN of th e selected  patient p olicy
  1077   "RTN","IBC NCH",98,0)
  1078    ;           DUZ      - IEN of t he user cr eating the  comment
  1079   "RTN","IBC NCH",99,0)
  1080    ; Returns : IEN numb er of newl y created  Patient Po licy Comme nt
  1081   "RTN","IBC NCH",100,0 )
  1082    N ERRMSG, FDA,IENS,N OW,RETIEN
  1083   "RTN","IBC NCH",101,0 )
  1084    S NOW=$$N OW^XLFDT()
  1085   "RTN","IBC NCH",102,0 )
  1086    S IENS="+ 1,"_IBIIEN _","_DFN_" ,"
  1087   "RTN","IBC NCH",103,0 )
  1088    S FDA(2.3 42,IENS,.0 1)=NOW                        ;  Date/Time  of the com ment
  1089   "RTN","IBC NCH",104,0 )
  1090    S FDA(2.3 42,IENS,.0 2)=DUZ                        ;  User addin g the comm ent
  1091   "RTN","IBC NCH",105,0 )
  1092    D UPDATE^ DIE("","FD A","RETIEN ","ERRMSG" )       ;  File new p olicy comm ent shell
  1093   "RTN","IBC NCH",106,0 )
  1094    Q RETIEN( 1)
  1095   "RTN","IBC NCH",107,0 )
  1096    ;
  1097   "RTN","IBC NCH",108,0 )
  1098   LOCKN(DFN, IBIIEN) ;  Lock Addin g of comme nts for a  specified  patient
  1099   "RTN","IBC NCH",109,0 )
  1100    ; and pol icy
  1101   "RTN","IBC NCH",110,0 )
  1102    ; Input:    DFN      - IEN of t he Patient  a comment  will be a dded for
  1103   "RTN","IBC NCH",111,0 )
  1104    ;           IBIIEN   - ^DPT(DFN ,.312,IBII EN,0) Wher e IBIIEN i s the
  1105   "RTN","IBC NCH",112,0 )
  1106    ;                      multiple  IEN of th e selected  patient p olicy
  1107   "RTN","IBC NCH",113,0 )
  1108    ; Returns : 1 - Lock  was obtai ned, 0 oth erwise
  1109   "RTN","IBC NCH",114,0 )
  1110    L +^POLCO M(DFN,IBII EN):3
  1111   "RTN","IBC NCH",115,0 )
  1112    I '$T Q 0
  1113   "RTN","IBC NCH",116,0 )
  1114    Q 1
  1115   "RTN","IBC NCH",117,0 )
  1116    ;
  1117   "RTN","IBC NCH",118,0 )
  1118   UNLOCKN(DF N,IBIIEN)  ; Unlock A dding of c omments fo r a specif ied patien t
  1119   "RTN","IBC NCH",119,0 )
  1120    ; Input:    DFN      - IEN of t he Patient  a comment  will be a dded for
  1121   "RTN","IBC NCH",120,0 )
  1122    ;           IBIIEN   - ^DPT(DFN ,.312,IBII EN,0) Wher e IBIIEN i s the
  1123   "RTN","IBC NCH",121,0 )
  1124    ;                      multiple  IEN of th e selected  patient p olicy
  1125   "RTN","IBC NCH",122,0 )
  1126    L -^POLCC OM(DFN,IBI IEN)
  1127   "RTN","IBC NCH",123,0 )
  1128    Q
  1129   "RTN","IBC NCH",124,0 )
  1130    ;
  1131   "RTN","IBC NCH",125,0 )
  1132   DELETE(COM IN)  ;EP
  1133   "RTN","IBC NCH",126,0 )
  1134    ; Protoco l action t o Delete a  Patient P olicy Comm ent
  1135   "RTN","IBC NCH",127,0 )
  1136    ; Input:    COMIN    - IEN of t he selecte d Patient  Policy Com ment
  1137   "RTN","IBC NCH",128,0 )
  1138    ;                      Optional  - Only se nt when ca lled from  the expand ed
  1139   "RTN","IBC NCH",129,0 )
  1140    ;                                  comment  listman t emplate.
  1141   "RTN","IBC NCH",130,0 )
  1142    ;           DFN      - IEN of t he selecte d Patient
  1143   "RTN","IBC NCH",131,0 )
  1144    ;           IBIIEN   - ^DPT(DFN ,.312,IBII EN,0) Wher e IBIIEN i s the
  1145   "RTN","IBC NCH",132,0 )
  1146    ;                      multiple  IEN of th e selected  patient p olicy
  1147   "RTN","IBC NCH",133,0 )
  1148    N COMIEN, DA,DIK,FRO MEE
  1149   "RTN","IBC NCH",134,0 )
  1150    S VALMBCK ="R"
  1151   "RTN","IBC NCH",135,0 )
  1152    D FULL^VA LM1
  1153   "RTN","IBC NCH",136,0 )
  1154    S COMIEN= $S($D(COMI N):COMIN,1 :"")
  1155   "RTN","IBC NCH",137,0 )
  1156    S FROMEE= $S(COMIEN' ="":1,1:0)
  1157   "RTN","IBC NCH",138,0 )
  1158    S:COMIEN= "" COMIEN= $$SELCOM(1 ,"Select C omment to  delete","" ,"IBCNCHIX ")
  1159   "RTN","IBC NCH",139,0 )
  1160    Q:COMIEN= ""
  1161   "RTN","IBC NCH",140,0 )
  1162    ;
  1163   "RTN","IBC NCH",141,0 )
  1164    ; Lock De letion of  this patie nt policy  comment
  1165   "RTN","IBC NCH",142,0 )
  1166    I '$$LOCK C(DFN,IBII EN,COMIEN)  D  Q
  1167   "RTN","IBC NCH",143,0 )
  1168    . W !!,*7 ,"Someone  is editing  or deleti ng this Pa tient Poli cy Comment ."
  1169   "RTN","IBC NCH",144,0 )
  1170    . W !,"Tr y again la ter."
  1171   "RTN","IBC NCH",145,0 )
  1172    . D PAUSE ^VALM1
  1173   "RTN","IBC NCH",146,0 )
  1174    ;
  1175   "RTN","IBC NCH",147,0 )
  1176    ; Ok to d elete this  comment?
  1177   "RTN","IBC NCH",148,0 )
  1178    S XX=$$OK 2EDIT(DFN, IBIIEN,COM IEN,"Delet e")
  1179   "RTN","IBC NCH",149,0 )
  1180    I +XX=-1  D  Q                                 ; Unab le to dele te
  1181   "RTN","IBC NCH",150,0 )
  1182    . D UNLOC KC(DFN,IBI IEN,COMIEN )
  1183   "RTN","IBC NCH",151,0 )
  1184    . W !,*7, $P(XX,"^", 2)
  1185   "RTN","IBC NCH",152,0 )
  1186    . D PAUSE ^VALM1
  1187   "RTN","IBC NCH",153,0 )
  1188    ;
  1189   "RTN","IBC NCH",154,0 )
  1190    ; Give fi nal Warnin g
  1191   "RTN","IBC NCH",155,0 )
  1192    I '$$ASKY N("Are you  Sure you  want to De lete this  Comment")  D  Q
  1193   "RTN","IBC NCH",156,0 )
  1194    . D UNLOC KC(DFN,IBI IEN,COMIEN )
  1195   "RTN","IBC NCH",157,0 )
  1196    ;
  1197   "RTN","IBC NCH",158,0 )
  1198    S DA=COMI EN,DA(1)=I BIIEN,DA(2 )=DFN
  1199   "RTN","IBC NCH",159,0 )
  1200    S DIK="^D PT(DA(2),. 312,DA(1), 13,"
  1201   "RTN","IBC NCH",160,0 )
  1202    D ^DIK                                         ; Dele te the Pat ient Polic y Comment
  1203   "RTN","IBC NCH",161,0 )
  1204    D UNLOCKC (DFN,IBIIE N,COMIEN)
  1205   "RTN","IBC NCH",162,0 )
  1206    I FROMEE= 1 S VALMBC K="Q" Q
  1207   "RTN","IBC NCH",163,0 )
  1208    D INIT                                         ; Rebu ild the li st
  1209   "RTN","IBC NCH",164,0 )
  1210    Q
  1211   "RTN","IBC NCH",165,0 )
  1212    ;
  1213   "RTN","IBC NCH",166,0 )
  1214   ASKYN(PROM PT,DEFAULT )   ; Ask  a yes/no q uestion
  1215   "RTN","IBC NCH",167,0 )
  1216    ; Input:    PROMPT       - Ques tion to be  asked
  1217   "RTN","IBC NCH",168,0 )
  1218    ;           DEFAULT      - Defa ult Answer
  1219   "RTN","IBC NCH",169,0 )
  1220    ;                          1 -  YES, 0 - N O
  1221   "RTN","IBC NCH",170,0 )
  1222    ;                          Opti onal, defa ults to 0
  1223   "RTN","IBC NCH",171,0 )
  1224    ; Returns : 1 - User  answered  YES, 0 oth erwise
  1225   "RTN","IBC NCH",172,0 )
  1226    N DIR,DIR OUT,DIRUT, DTOUT,DUOU T,X,Y
  1227   "RTN","IBC NCH",173,0 )
  1228    S:$G(DEFA ULT)'=1 DE FAULT=0
  1229   "RTN","IBC NCH",174,0 )
  1230    S DIR(0)= "Y",DIR("A ")=PROMPT
  1231   "RTN","IBC NCH",175,0 )
  1232    S DIR("B" )=$S(DEFAU LT:"YES",1 :"NO")
  1233   "RTN","IBC NCH",176,0 )
  1234    D ^DIR
  1235   "RTN","IBC NCH",177,0 )
  1236    Q Y
  1237   "RTN","IBC NCH",178,0 )
  1238    ;  
  1239   "RTN","IBC NCH",179,0 )
  1240   EDIT(COMIN )  ;EP
  1241   "RTN","IBC NCH",180,0 )
  1242    ; Protoco l action t o Edit a P atient Pol icy Commen t Fields
  1243   "RTN","IBC NCH",181,0 )
  1244    ; Input:    COMIN    - IEN of t he selecte d Patient  Policy Com ment
  1245   "RTN","IBC NCH",182,0 )
  1246    ;                      Optional  - Only se nt when ca lled from  the expand ed
  1247   "RTN","IBC NCH",183,0 )
  1248    ;                                  comment  listman t emplate.
  1249   "RTN","IBC NCH",184,0 )
  1250    ;           DFN      - IEN of t he selecte d Patient
  1251   "RTN","IBC NCH",185,0 )
  1252    ;           IBIIEN   - ^DPT(DFN ,.312,IBII EN,0) Wher e IBIIEN i s the
  1253   "RTN","IBC NCH",186,0 )
  1254    ;                      multiple  IEN of th e selected  patient p olicy
  1255   "RTN","IBC NCH",187,0 )
  1256    N COMCNT, COMIEN,DA, DIC,DIE,DO ,DR,DTOUT, EDT,FROMEE ,LINE,SRCH TXT,X,XX,Y
  1257   "RTN","IBC NCH",188,0 )
  1258    S COMIEN= $S($D(COMI N):COMIN,1 :"")
  1259   "RTN","IBC NCH",189,0 )
  1260    S FROMEE= $S(COMIEN' ="":1,1:0)
  1261   "RTN","IBC NCH",190,0 )
  1262    S VALMBCK ="R"
  1263   "RTN","IBC NCH",191,0 )
  1264    D FULL^VA LM1
  1265   "RTN","IBC NCH",192,0 )
  1266    S:COMIEN= "" COMIEN= $$SELCOM(1 ,"Select C omment to  edit",.COM CNT,"IBCNC HIX")
  1267   "RTN","IBC NCH",193,0 )
  1268    Q:COMIEN= ""
  1269   "RTN","IBC NCH",194,0 )
  1270    D EDITCOM (DFN,IBIIE N,COMIEN,F ROMEE)
  1271   "RTN","IBC NCH",195,0 )
  1272    Q
  1273   "RTN","IBC NCH",196,0 )
  1274    ;
  1275   "RTN","IBC NCH",197,0 )
  1276   EDITCOM(DF N,IBIIEN,C OMIEN,FROM EE) ; Edit  the selec ted commen t
  1277   "RTN","IBC NCH",198,0 )
  1278    ; Called  from EDIT  and ADDCOM
  1279   "RTN","IBC NCH",199,0 )
  1280    ; Input:    DFN      - IEN of t he selecte d Patient
  1281   "RTN","IBC NCH",200,0 )
  1282    ;           IBIIEN   - ^DPT(DFN ,.312,IBII EN,0) Wher e IBIIEN i s the
  1283   "RTN","IBC NCH",201,0 )
  1284    ;                      multiple  IEN of th e selected  patient p olicy
  1285   "RTN","IBC NCH",202,0 )
  1286    ;           COMIEN   - IEN of t he comment  being edi ted
  1287   "RTN","IBC NCH",203,0 )
  1288    ;           FROMEE   - 1 edit f rom Expand  Entry, 0  otherwise
  1289   "RTN","IBC NCH",204,0 )
  1290    ;                      Optional , defaults  to 0
  1291   "RTN","IBC NCH",205,0 )
  1292    S:'$D(FRO MEE) FROME E=0
  1293   "RTN","IBC NCH",206,0 )
  1294    ;
  1295   "RTN","IBC NCH",207,0 )
  1296    ; Lock Ed iting of t his patien t policy c omment
  1297   "RTN","IBC NCH",208,0 )
  1298    I '$$LOCK C(DFN,IBII EN,COMIEN)  D  Q
  1299   "RTN","IBC NCH",209,0 )
  1300    . W !!,*7 ,"Someone  else is ed iting or d eleting th is Patient  Policy Co mment."
  1301   "RTN","IBC NCH",210,0 )
  1302    . W !,"Tr y again la ter."
  1303   "RTN","IBC NCH",211,0 )
  1304    . D PAUSE ^VALM1
  1305   "RTN","IBC NCH",212,0 )
  1306    ;
  1307   "RTN","IBC NCH",213,0 )
  1308    ; Ok to e dit this c omment?
  1309   "RTN","IBC NCH",214,0 )
  1310    S XX=$$OK 2EDIT(DFN, IBIIEN,COM IEN,"Edit" )
  1311   "RTN","IBC NCH",215,0 )
  1312    I +XX=-1  D  Q                                 ; Unab le to edit
  1313   "RTN","IBC NCH",216,0 )
  1314    . D UNLOC KC(DFN,IBI IEN,COMIEN )
  1315   "RTN","IBC NCH",217,0 )
  1316    . W !,*7, $P(XX,"^", 2)
  1317   "RTN","IBC NCH",218,0 )
  1318    . D PAUSE ^VALM1
  1319   "RTN","IBC NCH",219,0 )
  1320    ;
  1321   "RTN","IBC NCH",220,0 )
  1322    ; Let the  user edit  the comme nt
  1323   "RTN","IBC NCH",221,0 )
  1324    S EDT=$$N OW^XLFDT()
  1325   "RTN","IBC NCH",222,0 )
  1326    S DIE="^D PT(DFN,.31 2,IBIIEN,1 3,"
  1327   "RTN","IBC NCH",223,0 )
  1328    S DA=COMI EN,DA(1)=I BIIEN,DA(2 )=DFN
  1329   "RTN","IBC NCH",224,0 )
  1330    S DR=".01 ///"_EDT_" ;.02///"_D UZ_";.04Pe rson Conta cted;.05Co ntact Pers on Phone"
  1331   "RTN","IBC NCH",225,0 )
  1332    S DR=DR_" ;.07Contac t Method;. 06Call Ref erence Num ber;.08Aut horization  Number"
  1333   "RTN","IBC NCH",226,0 )
  1334    S DR=DR_" ;.03Commen t"
  1335   "RTN","IBC NCH",227,0 )
  1336    D ^DIE
  1337   "RTN","IBC NCH",228,0 )
  1338    D UNLOCKC (DFN,IBIIE N,COMIEN)
  1339   "RTN","IBC NCH",229,0 )
  1340    I FROMEE  D INIT^IBC NCH3 Q
  1341   "RTN","IBC NCH",230,0 )
  1342    D INIT                                         ; Rebu ild the li st
  1343   "RTN","IBC NCH",231,0 )
  1344    Q
  1345   "RTN","IBC NCH",232,0 )
  1346    ;
  1347   "RTN","IBC NCH",233,0 )
  1348   OK2EDIT(DF N,IBIIEN,C OMIEN,WHIC H) ; Check  to see if  it's ok t o Edit/Del ete the
  1349   "RTN","IBC NCH",234,0 )
  1350    ; selecte d Patient  Policy Com ment
  1351   "RTN","IBC NCH",235,0 )
  1352    ; Input:    DFN      - IEN of t he selecte d Patient
  1353   "RTN","IBC NCH",236,0 )
  1354    ;           IBIIEN   - ^DPT(DFN ,.312,IBII EN,0) Wher e IBIIEN i s the
  1355   "RTN","IBC NCH",237,0 )
  1356    ;                      multiple  IEN of th e selected  patient p olicy
  1357   "RTN","IBC NCH",238,0 )
  1358    ;           COMIEN   - IEN of t he selecte d Patient  Policy com ment
  1359   "RTN","IBC NCH",239,0 )
  1360    ;           WHICH    - 'Delete'  when call ed from DE LETE
  1361   "RTN","IBC NCH",240,0 )
  1362    ;                      'Edit' w he called  fomr EDIT
  1363   "RTN","IBC NCH",241,0 )
  1364    ; Returns : 1 - OK t o edit or  delete, -1 ^Error Mes sage other wise
  1365   "RTN","IBC NCH",242,0 )
  1366    N COMDT,O K,TDT,XX
  1367   "RTN","IBC NCH",243,0 )
  1368    S OK=1                                             ;  Assume it' s OK
  1369   "RTN","IBC NCH",244,0 )
  1370    ;
  1371   "RTN","IBC NCH",245,0 )
  1372    ; Make su re the sel ected comm ent is the  latest co mment
  1373   "RTN","IBC NCH",246,0 )
  1374    S COMDT=$ O(^DPT(DFN ,.312,IBII EN,13,"B", ""),-1)
  1375   "RTN","IBC NCH",247,0 )
  1376    S XX=$O(^ DPT(DFN,.3 12,IBIIEN, 13,"B",COM DT,""))
  1377   "RTN","IBC NCH",248,0 )
  1378    I COMIEN' =XX D  Q O K
  1379   "RTN","IBC NCH",249,0 )
  1380    . S OK="- 1^Unable t o "_WHICH_ ". Selecte d comment  is not the  latest co mment."
  1381   "RTN","IBC NCH",250,0 )
  1382    ;
  1383   "RTN","IBC NCH",251,0 )
  1384    ; Make su re the use r trying t o edit or  delete is  the user w ho entered  the
  1385   "RTN","IBC NCH",252,0 )
  1386    ; comment
  1387   "RTN","IBC NCH",253,0 )
  1388    S XX=$$GE T1^DIQ(2.3 42,COMIEN_ ","_IBIIEN _","_DFN_" ,",.02,"I" )
  1389   "RTN","IBC NCH",254,0 )
  1390    I XX'=DUZ  D  Q OK
  1391   "RTN","IBC NCH",255,0 )
  1392    . S OK="- 1^Unable t o "_WHICH_ ". Selecte d comment  was entere d by a dif ferent use r."
  1393   "RTN","IBC NCH",256,0 )
  1394    ;
  1395   "RTN","IBC NCH",257,0 )
  1396    ; Make su re today's  date is t he same as  when the  comment wa s last edi ted
  1397   "RTN","IBC NCH",258,0 )
  1398    ; comment
  1399   "RTN","IBC NCH",259,0 )
  1400    S XX=$$GE T1^DIQ(2.3 42,COMIEN_ ","_IBIIEN _","_DFN_" ,",.01,"I" )
  1401   "RTN","IBC NCH",260,0 )
  1402    S XX=$P(X X,".",1)
  1403   "RTN","IBC NCH",261,0 )
  1404    S TDT=$$N OW^XLFDT() ,TDT=$P(TD T,".",1)
  1405   "RTN","IBC NCH",262,0 )
  1406    I XX'=TDT  D  Q OK
  1407   "RTN","IBC NCH",263,0 )
  1408    . S OK="- 1^Unable t o "_WHICH_ ". Selecte d comment  is outside  the "_WHI CH_" windo w."
  1409   "RTN","IBC NCH",264,0 )
  1410    Q OK
  1411   "RTN","IBC NCH",265,0 )
  1412    ;
  1413   "RTN","IBC NCH",266,0 )
  1414   LOCKC(DFN, IBIIEN,COM IEN) ; Loc k Editing  of a selec ted Patien t Policy C omment
  1415   "RTN","IBC NCH",267,0 )
  1416    ; Input:    DFN      - IEN of t he Patient  a comment  will be a dded for
  1417   "RTN","IBC NCH",268,0 )
  1418    ;           IBIIEN   - ^DPT(DFN ,.312,IBII EN,0) Wher e IBIIEN i s the
  1419   "RTN","IBC NCH",269,0 )
  1420    ;                      multiple  IEN of th e selected  patient p olicy
  1421   "RTN","IBC NCH",270,0 )
  1422    ;           COMIEN   - IEN of t he Patient  Policy co mment bein g edited
  1423   "RTN","IBC NCH",271,0 )
  1424    ; Returns : 1 - Lock  was obtai ned, 0 oth erwise
  1425   "RTN","IBC NCH",272,0 )
  1426    L +^POLCO M(DFN,IBII EN,COMIEN) :3
  1427   "RTN","IBC NCH",273,0 )
  1428    I '$T Q 0
  1429   "RTN","IBC NCH",274,0 )
  1430    Q 1
  1431   "RTN","IBC NCH",275,0 )
  1432    ;
  1433   "RTN","IBC NCH",276,0 )
  1434   UNLOCKC(DF N,IBIIEN,C OMIEN) ; U nlock Edit ing of a s elected Pa tient Poli cy Comment
  1435   "RTN","IBC NCH",277,0 )
  1436    ; Input:    DFN      - IEN of t he Patient  a comment  will be a dded for
  1437   "RTN","IBC NCH",278,0 )
  1438    ;           IBIIEN   - ^DPT(DFN ,.312,IBII EN,0) Wher e IBIIEN i s the
  1439   "RTN","IBC NCH",279,0 )
  1440    ;                      multiple  IEN of th e selected  patient p olicy
  1441   "RTN","IBC NCH",280,0 )
  1442    ;           COMIEN   - IEN of t he Patient  Policy co mment bein g edited
  1443   "RTN","IBC NCH",281,0 )
  1444    L -^POLCC OM(DFN,IBI IEN,COMIEN )
  1445   "RTN","IBC NCH",282,0 )
  1446    Q
  1447   "RTN","IBC NCH",283,0 )
  1448    ;
  1449   "RTN","IBC NCH",284,0 )
  1450   HELP ;EP
  1451   "RTN","IBC NCH",285,0 )
  1452    ; Display  the listm an templat e help
  1453   "RTN","IBC NCH",286,0 )
  1454    N X
  1455   "RTN","IBC NCH",287,0 )
  1456    S X="?"
  1457   "RTN","IBC NCH",288,0 )
  1458    D DISP^XQ ORM1
  1459   "RTN","IBC NCH",289,0 )
  1460    W !!
  1461   "RTN","IBC NCH",290,0 )
  1462    Q
  1463   "RTN","IBC NCH",291,0 )
  1464    ;
  1465   "RTN","IBC NCH",292,0 )
  1466   SELCOM(FUL L,PROMPT,C OMCNT,WLIS T)    ;EP
  1467   "RTN","IBC NCH",293,0 )
  1468    ; Select  Entry(s) t o perform  an action  upon
  1469   "RTN","IBC NCH",294,0 )
  1470    ; Input:    FULL                  - 1 - fu ll screen  mode, 0 ot herwise
  1471   "RTN","IBC NCH",295,0 )
  1472    ;           PROMPT                - Prompt  to be dis played to  the user
  1473   "RTN","IBC NCH",296,0 )
  1474    ;           WLIST                 - Workli st, the us er is sele cting from
  1475   "RTN","IBC NCH",297,0 )
  1476    ;           ^TMP($J, "IBCNCHIX" ) - Index  of display ed lines o f the Comm ent 
  1477   "RTN","IBC NCH",298,0 )
  1478    ;                                   Histor y Worklist
  1479   "RTN","IBC NCH",299,0 )
  1480    ; Output:   COMCNT                - Commen t Number o f the sele cted Comme nt
  1481   "RTN","IBC NCH",300,0 )
  1482    ; Returns : Select C omment IEN
  1483   "RTN","IBC NCH",301,0 )
  1484    ;           Error me ssage if i nvalid sel ection
  1485   "RTN","IBC NCH",302,0 )
  1486    N COMIEN, DIROUT,DIR UT,DLINE,D TOUT,DUOUT ,END,START ,X,Y
  1487   "RTN","IBC NCH",303,0 )
  1488    S:'$D(WLI ST) WLIST= "IBCNCHIX"
  1489   "RTN","IBC NCH",304,0 )
  1490    S START=1 ,END=$O(^T MP($J,WLIS T,""),-1)+ 0
  1491   "RTN","IBC NCH",305,0 )
  1492    D:FULL FU LL^VALM1
  1493   "RTN","IBC NCH",306,0 )
  1494    S COMCNT= $P($P($G(X QORNOD(0)) ,"^",4),"= ",2)    ;  User selec tion with  action
  1495   "RTN","IBC NCH",307,0 )
  1496    S COMCNT= $TR(COMCNT ,"/\; ."," ,,,,,")            ;  Check for  multi-sele ction
  1497   "RTN","IBC NCH",308,0 )
  1498    ;
  1499   "RTN","IBC NCH",309,0 )
  1500    I COMCNT[ "," D  Q " "                             ;  Invalid mu lti-select ion
  1501   "RTN","IBC NCH",310,0 )
  1502    . W !,*7, ">>>> Only  single en try select ion is all owed"
  1503   "RTN","IBC NCH",311,0 )
  1504    . K DIR
  1505   "RTN","IBC NCH",312,0 )
  1506    . D PAUSE ^VALM1
  1507   "RTN","IBC NCH",313,0 )
  1508    ;
  1509   "RTN","IBC NCH",314,0 )
  1510    I $O(^TMP ($J,"IBCNC HIX",""))= "" D  Q ""
  1511   "RTN","IBC NCH",315,0 )
  1512    . S X=$P( PROMPT," " ,$L(PROMPT ," "))
  1513   "RTN","IBC NCH",316,0 )
  1514    . W !,*7, ">>>> No c omments to  "_X
  1515   "RTN","IBC NCH",317,0 )
  1516    . K DIR
  1517   "RTN","IBC NCH",318,0 )
  1518    . D PAUSE ^VALM1
  1519   "RTN","IBC NCH",319,0 )
  1520    ;
  1521   "RTN","IBC NCH",320,0 )
  1522    S:COMCNT= "" COMCNT= $$SELENTRY (PROMPT,ST ART,END)
  1523   "RTN","IBC NCH",321,0 )
  1524    Q:COMCNT= "" ""
  1525   "RTN","IBC NCH",322,0 )
  1526    S COMIEN= $P($G(^TMP ($J,"IBCNC HIX",COMCN T)),"^",9)
  1527   "RTN","IBC NCH",323,0 )
  1528    I COMIEN= "" D  Q ""
  1529   "RTN","IBC NCH",324,0 )
  1530    . W !,*7, ">>>> Inva lid select ion number "
  1531   "RTN","IBC NCH",325,0 )
  1532    . K DIR
  1533   "RTN","IBC NCH",326,0 )
  1534    . D PAUSE ^VALM1
  1535   "RTN","IBC NCH",327,0 )
  1536    Q COMIEN
  1537   "RTN","IBC NCH",328,0 )
  1538    ;
  1539   "RTN","IBC NCH",329,0 )
  1540   DELCOM(DFN ,IBIIEN,CO MIEN) ; Ch ecks to se e if the u ser was at tempting t o
  1541   "RTN","IBC NCH",330,0 )
  1542    ; create  new Patien t Policy c omment but  didn't en ter a comm ent. If so ,
  1543   "RTN","IBC NCH",331,0 )
  1544    ; If so,  the new Pa tient Poli cy Comment  is delete d
  1545   "RTN","IBC NCH",332,0 )
  1546    ; Input:    DFN      - IEN of t he Patient  a policy  comment is  being add ed for
  1547   "RTN","IBC NCH",333,0 )
  1548    ;           IBIIEN   - IEN of t he Policy  a policy c omment is  being adde d for
  1549   "RTN","IBC NCH",334,0 )
  1550    ;           COMIEN   - IEN of t he new Pol icy Commen t being ad ded
  1551   "RTN","IBC NCH",335,0 )
  1552    ; Returns : 1 - New  Patient Po licy Comme nt was del eted, 0 ot herwise
  1553   "RTN","IBC NCH",336,0 )
  1554    ;           
  1555   "RTN","IBC NCH",337,0 )
  1556    N DA,DIK, IENS,X,XX, Y
  1557   "RTN","IBC NCH",338,0 )
  1558    S IENS=CO MIEN_","_I BIIEN_","_ DFN_","
  1559   "RTN","IBC NCH",339,0 )
  1560    S XX=$$GE T1^DIQ(2.3 42,IENS,.0 3)                      ; Check  the commen t field
  1561   "RTN","IBC NCH",340,0 )
  1562    Q:XX'=""  0
  1563   "RTN","IBC NCH",341,0 )
  1564    S DA=COMI EN,DA(1)=I BIIEN,DA(2 )=DFN
  1565   "RTN","IBC NCH",342,0 )
  1566    S DIK="^D PT(DA(2),. 312,DA(1), 13,"
  1567   "RTN","IBC NCH",343,0 )
  1568    D ^DIK                                                  ; Delete  the multi ple
  1569   "RTN","IBC NCH",344,0 )
  1570    Q 1
  1571   "RTN","IBC NCH",345,0 )
  1572    ;
  1573   "RTN","IBC NCH",346,0 )
  1574   SELENTRY(P ROMPT,STAR T,END)     ; select a  comment
  1575   "RTN","IBC NCH",347,0 )
  1576    ; Input:    PROMPT   - Prompt t o be displ ayed to th e user
  1577   "RTN","IBC NCH",348,0 )
  1578    ;           START    - Start co mment # th at can be  selected
  1579   "RTN","IBC NCH",349,0 )
  1580    ;           END      - Ending c omment # t hat can be  selected
  1581   "RTN","IBC NCH",350,0 )
  1582    ; Returns : Selected  Comment #  or "" if  not select ed
  1583   "RTN","IBC NCH",351,0 )
  1584    N DIR,DIR OUT,DIRUT, DTOUT,DUOU T,X,Y
  1585   "RTN","IBC NCH",352,0 )
  1586    S DIR(0)= "NO^"_STAR T_":"_END_ ":0"
  1587   "RTN","IBC NCH",353,0 )
  1588    S DIR("A" )=PROMPT
  1589   "RTN","IBC NCH",354,0 )
  1590    D ^DIR K  DIR
  1591   "RTN","IBC NCH",355,0 )
  1592    Q X
  1593   "RTN","IBC NCH",356,0 )
  1594    ;
  1595   "RTN","IBC NCH",357,0 )
  1596   EXIT ;EP
  1597   "RTN","IBC NCH",358,0 )
  1598    ; Exit th e listman  template
  1599   "RTN","IBC NCH",359,0 )
  1600    K ^TMP("I BCNCH",$J) ,^TMP($J," IBCNCHIX")
  1601   "RTN","IBC NCH",360,0 )
  1602    D CLEAR^V ALM1
  1603   "RTN","IBC NCH",361,0 )
  1604    Q
  1605   "RTN","IBC NEHLT")
  1606   0^11^B9374 3672^B1005 67838
  1607   "RTN","IBC NEHLT",1,0 )
  1608   IBCNEHLT ; DAOU/ALA -  HL7 Proce ss Incomin g MFN Mess ages ; 15  Mar 2016   3:00 PM
  1609   "RTN","IBC NEHLT",2,0 )
  1610    ;;2.0;INT EGRATED BI LLING;**18 4,251,271, 300,416,43 8,506,549, 582**;21-M AR-94;Buil d 77
  1611   "RTN","IBC NEHLT",3,0 )
  1612    ;;Per VA  Directive  6402, this  routine s hould not  be modifie d.
  1613   "RTN","IBC NEHLT",4,0 )
  1614    ;
  1615   "RTN","IBC NEHLT",5,0 )
  1616    ;**Progra m Descript ion**
  1617   "RTN","IBC NEHLT",6,0 )
  1618    ;  This p rogram wil l process  incoming M FN message s and
  1619   "RTN","IBC NEHLT",7,0 )
  1620    ;  update  the appro priate tab les
  1621   "RTN","IBC NEHLT",8,0 )
  1622    ;
  1623   "RTN","IBC NEHLT",9,0 )
  1624   EN ;  Entr y Point
  1625   "RTN","IBC NEHLT",10, 0)
  1626    NEW AIEN, APIEN,APP, D0,D,DESC, DQ,DR,FILE ,FLN,HEDI, ID,IEN
  1627   "RTN","IBC NEHLT",11, 0)
  1628    NEW PEDI, SEG,STAT,H CT,NEWID,T SSN,REQSUB ,NAFLG,NPF LG,TRUSTED
  1629   "RTN","IBC NEHLT",12, 0)
  1630    NEW IBCNA CT,IBCNADT ,FSVDY,PSV DY
  1631   "RTN","IBC NEHLT",13, 0)
  1632    NEW BPSIE N,CMIEN,DA TA,DATAAP, DATABPS,DA TACM,DATE, ERROR,FIEL DNO,FILENO
  1633   "RTN","IBC NEHLT",14, 0)
  1634    NEW IBSEG ,MSG,BUFF
  1635   "RTN","IBC NEHLT",15, 0)
  1636    NEW X12TA BLE,BADFMT
  1637   "RTN","IBC NEHLT",16, 0)
  1638    ;
  1639   "RTN","IBC NEHLT",17, 0)
  1640    ; BADFMT  is true if  a site wi th patch 3 00 receive s an eIV m essage in  the previo us HL7 int erface str ucture (pr e-300)
  1641   "RTN","IBC NEHLT",18, 0)
  1642    ;
  1643   "RTN","IBC NEHLT",19, 0)
  1644    ; ** With  national  release of  IB*2*550  ePharmacy  will no lo nger use t his routin e to proce ss table
  1645   "RTN","IBC NEHLT",20, 0)
  1646    ;    upda tes.
  1647   "RTN","IBC NEHLT",21, 0)
  1648    ; ** Ther efore, sev eral lines  of code w ill become  obsolete  as comment ed in this  routine.
  1649   "RTN","IBC NEHLT",22, 0)
  1650    ;
  1651   "RTN","IBC NEHLT",23, 0)
  1652    ; ** Upon  national  release of  IB*2*550  reword sta tement bel ow to drop  ePHARM re ference
  1653   "RTN","IBC NEHLT",24, 0)
  1654    ;
  1655   "RTN","IBC NEHLT",25, 0)
  1656    ; Build l ocal table  of file n umbers to  determine  if respons e is eIV o r ePHARM
  1657   "RTN","IBC NEHLT",26, 0)
  1658    ; * Warni ng: Before  adding a  new table  to be upda ted by FSC , one must  get FSC
  1659   "RTN","IBC NEHLT",27, 0)
  1660    ;             to agr ee and the  eIV ICD d ocumentati on has to  be updated  and 
  1661   "RTN","IBC NEHLT",28, 0)
  1662    ;             approv ed by the  VA HL7 tea m. Just ad ding a tab le number  here does
  1663   "RTN","IBC NEHLT",29, 0)
  1664    ;             absolu tely nothi ng without  involving  the other  teams.
  1665   "RTN","IBC NEHLT",30, 0)
  1666    ;
  1667   "RTN","IBC NEHLT",31, 0)
  1668    F D=11:1: 18 S X12TA BLE("365.0 "_D)=""
  1669   "RTN","IBC NEHLT",32, 0)
  1670    ;F D=21:1 :28 S X12T ABLE("365. 0"_D)=""
  1671   "RTN","IBC NEHLT",33, 0)
  1672    S X12TABL E(350.021) =""
  1673   "RTN","IBC NEHLT",34, 0)
  1674    S X12TABL E(350.9)=" "     ; IB *2.0*506
  1675   "RTN","IBC NEHLT",35, 0)
  1676    S X12TABL E(350.9002 )=""  ; IB *2.0*549
  1677   "RTN","IBC NEHLT",36, 0)
  1678    ;
  1679   "RTN","IBC NEHLT",37, 0)
  1680    ; Decide  if message  belongs t o "E-Pharm " or "eIV"
  1681   "RTN","IBC NEHLT",38, 0)
  1682    S APP=""
  1683   "RTN","IBC NEHLT",39, 0)
  1684    S HCT=0,E RFLG=0
  1685   "RTN","IBC NEHLT",40, 0)
  1686    F  S HCT= $O(^TMP($J ,"IBCNEHLI ",HCT)) Q: HCT=""  D  SPAR^IBCNE HLU I $G(I BSEG(1))=" MFI" S FIL E=$G(IBSEG (2)),FLN=$ P(FILE,$E( HLECH,1),1 ) Q
  1687   "RTN","IBC NEHLT",41, 0)
  1688    I ",366.0 1,366.02,3 66.03,365. 12,355.3," [(","_FLN_ ",") S APP ="E-PHARM"    ; ** Ob solete lin e upon rel ease of IB *2*550
  1689   "RTN","IBC NEHLT",42, 0)
  1690    I FLN=365 .12 D
  1691   "RTN","IBC NEHLT",43, 0)
  1692    . S HCT=0 ,BADFMT=0
  1693   "RTN","IBC NEHLT",44, 0)
  1694    . F  S HC T=$O(^TMP( $J,"IBCNEH LI",HCT))  Q:HCT=""   D  Q:(APP= "IIV")!BAD FMT
  1695   "RTN","IBC NEHLT",45, 0)
  1696    .. D SPAR ^IBCNEHLU
  1697   "RTN","IBC NEHLT",46, 0)
  1698    .. I $G(I BSEG(1))=" MFE",$P($G (IBSEG(5)) ,$E(HLECH, 1),3)'=""  D  Q
  1699   "RTN","IBC NEHLT",47, 0)
  1700    ... S BAD FMT=1,APP= ""
  1701   "RTN","IBC NEHLT",48, 0)
  1702    ... S MSG (1)="Log a  Remedy Ti cket for t his issue. "
  1703   "RTN","IBC NEHLT",49, 0)
  1704    ... S MSG (2)="Pleas e include  in the Rem edy Ticket  that the  Vista eIV  payer tabl es may be  out"
  1705   "RTN","IBC NEHLT",50, 0)
  1706    ... S MSG (3)="of sy nc with th e master l ist and wi ll need a  new copy o f the paye r table"
  1707   "RTN","IBC NEHLT",51, 0)
  1708    ... S MSG (4)="updat e message  from Austi n."
  1709   "RTN","IBC NEHLT",52, 0)
  1710    ... D MSG ^IBCNEUT5( $$MGRP^IBC NEUT5(),"e IV payer t ables may  be out of  synch with  master li st","MSG(" )
  1711   "RTN","IBC NEHLT",53, 0)
  1712    .. I $G(I BSEG(1))=" ZPA" S APP ="IIV"
  1713   "RTN","IBC NEHLT",54, 0)
  1714    I $D(X12T ABLE(FLN))  S APP="II V"
  1715   "RTN","IBC NEHLT",55, 0)
  1716    ;
  1717   "RTN","IBC NEHLT",56, 0)
  1718    ; ** Upon  release o f IB*2*550 , drop the  ePharm re ference in  the comme nt below
  1719   "RTN","IBC NEHLT",57, 0)
  1720    ; If neit her eIV or  ePHARM th en quit
  1721   "RTN","IBC NEHLT",58, 0)
  1722    I APP=""  Q
  1723   "RTN","IBC NEHLT",59, 0)
  1724    ;
  1725   "RTN","IBC NEHLT",60, 0)
  1726    S HCT=1,N AFLG=0,NPF LG=0,D=""
  1727   "RTN","IBC NEHLT",61, 0)
  1728    F  S HCT= $O(^TMP($J ,"IBCNEHLI ",HCT)) Q: HCT=""  D   Q:ERFLG
  1729   "RTN","IBC NEHLT",62, 0)
  1730    . D SPAR^ IBCNEHLU
  1731   "RTN","IBC NEHLT",63, 0)
  1732    . S SEG=$ G(IBSEG(1) )
  1733   "RTN","IBC NEHLT",64, 0)
  1734    . ;
  1735   "RTN","IBC NEHLT",65, 0)
  1736    . I APP=" E-PHARM" D    ;  ** T his Do-loo p is obsol ete upon r elease of  IB*2*550
  1737   "RTN","IBC NEHLT",66, 0)
  1738    .. I SEG= "MFI" D
  1739   "RTN","IBC NEHLT",67, 0)
  1740    ... S FIL E=$G(IBSEG (2))
  1741   "RTN","IBC NEHLT",68, 0)
  1742    ... S FLN =$P(FILE,$ E(HLECH,1) ,1)
  1743   "RTN","IBC NEHLT",69, 0)
  1744    ... ;
  1745   "RTN","IBC NEHLT",70, 0)
  1746    ... ; Ini tialize MF K Message  (Applicati on Acknowl edgement)  variables
  1747   "RTN","IBC NEHLT",71, 0)
  1748    ... ; Mas ter File I dentifier
  1749   "RTN","IBC NEHLT",72, 0)
  1750    ... S DAT AMFK("MFI- 1")=$G(IBS EG(2))
  1751   "RTN","IBC NEHLT",73, 0)
  1752    ... ;
  1753   "RTN","IBC NEHLT",74, 0)
  1754    ... ; Fil e-Level Ev ent Code
  1755   "RTN","IBC NEHLT",75, 0)
  1756    ... S DAT AMFK("MFI- 3")=$G(IBS EG(4))
  1757   "RTN","IBC NEHLT",76, 0)
  1758    .. ;
  1759   "RTN","IBC NEHLT",77, 0)
  1760    .. I SEG= "MFE" D
  1761   "RTN","IBC NEHLT",78, 0)
  1762    ... I $G( FLN)="" S  ERFLG=1,MS G(1)="File  Number no t found in  MFN messa ge" Q
  1763   "RTN","IBC NEHLT",79, 0)
  1764    ... I '$$ VFILE^DILF D(FLN) S E RFLG=1,MSG (1)="File  "_FLN_" no t found in  the Data  Dictionary " Q
  1765   "RTN","IBC NEHLT",80, 0)
  1766    ... ;
  1767   "RTN","IBC NEHLT",81, 0)
  1768    ... ; Ini tialize MF K Message  (Applicati on Acknowl edgement)  variables
  1769   "RTN","IBC NEHLT",82, 0)
  1770    ... ; Rec ord-Level  Event Code
  1771   "RTN","IBC NEHLT",83, 0)
  1772    ... S DAT AMFK("MFE- 1")=$G(IBS EG(2))
  1773   "RTN","IBC NEHLT",84, 0)
  1774    ... ;
  1775   "RTN","IBC NEHLT",85, 0)
  1776    ... ; Pri mary Key V alue
  1777   "RTN","IBC NEHLT",86, 0)
  1778    ... S DAT AMFK("MFE- 4")=$G(IBS EG(5))
  1779   "RTN","IBC NEHLT",87, 0)
  1780    ... ;
  1781   "RTN","IBC NEHLT",88, 0)
  1782    ... ; Pri mary Key V alue Type
  1783   "RTN","IBC NEHLT",89, 0)
  1784    ... S DAT AMFK("MFE- 5")=$G(IBS EG(6))
  1785   "RTN","IBC NEHLT",90, 0)
  1786    ... ;
  1787   "RTN","IBC NEHLT",91, 0)
  1788    ... ; Tra nsfer cont rol to e-P harmacy
  1789   "RTN","IBC NEHLT",92, 0)
  1790    ... D ^IB CNRHLT Q
  1791   "RTN","IBC NEHLT",93, 0)
  1792    .. ;
  1793   "RTN","IBC NEHLT",94, 0)
  1794    .. ; Tran sfer contr ol on othe r segments
  1795   "RTN","IBC NEHLT",95, 0)
  1796    .. I ",ZC M,ZP0,ZPB, ZPL,ZPT,ZR X,"[(","_S EG_",") D  ^IBCNRHLT
  1797   "RTN","IBC NEHLT",96, 0)
  1798    . ; ** en d of obsol ete do-loo p upon nat ional rele ase of IB* 2*550
  1799   "RTN","IBC NEHLT",97, 0)
  1800    . ;
  1801   "RTN","IBC NEHLT",98, 0)
  1802    . ;
  1803   "RTN","IBC NEHLT",99, 0)
  1804    . ;** Upo n release  of IB*2*55 0 this if  statement  (I APP="II V") won't  be necessa ry but it  DOES NOT
  1805   "RTN","IBC NEHLT",100 ,0)
  1806    . ;   hur t to leave  it in mov ing forwar d as a saf ety valve.
  1807   "RTN","IBC NEHLT",101 ,0)
  1808    . I APP=" IIV" D
  1809   "RTN","IBC NEHLT",102 ,0)
  1810    .. I SEG= "MFI" D
  1811   "RTN","IBC NEHLT",103 ,0)
  1812    ... S FIL E=$G(IBSEG (2))
  1813   "RTN","IBC NEHLT",104 ,0)
  1814    ... S FLN =$P(FILE,$ E(HLECH,1) ,1)
  1815   "RTN","IBC NEHLT",105 ,0)
  1816    .. ;
  1817   "RTN","IBC NEHLT",106 ,0)
  1818    .. I SEG= "MFE" D
  1819   "RTN","IBC NEHLT",107 ,0)
  1820    ... I $G( FLN)="" S  ERFLG=1,MS G(1)="File  Number no t found in  MFN messa ge" Q
  1821   "RTN","IBC NEHLT",108 ,0)
  1822    ... I '$$ VFILE^DILF D(FLN) S E RFLG=1,MSG (1)="File  "_FLN_" no t found in  the Data  Dictionary " Q
  1823   "RTN","IBC NEHLT",109 ,0)
  1824    ... ;
  1825   "RTN","IBC NEHLT",110 ,0)
  1826    ... I FLN '=365.12 D   Q
  1827   "RTN","IBC NEHLT",111 ,0)
  1828    .... S DA TA=$G(IBSE G(5))
  1829   "RTN","IBC NEHLT",112 ,0)
  1830    .... S ID =$$DECHL7^ IBCNEHL2($ P(DATA,$E( HLECH,1),1 )),DESC=$$ DECHL7^IBC NEHL2($P(D ATA,$E(HLE CH,1),2))
  1831   "RTN","IBC NEHLT",113 ,0)
  1832    .... D TF IL
  1833   "RTN","IBC NEHLT",114 ,0)
  1834    ... ;
  1835   "RTN","IBC NEHLT",115 ,0)
  1836    ... ; Pul l the acti on code
  1837   "RTN","IBC NEHLT",116 ,0)
  1838    ... S IBC NACT=$G(IB SEG(2))
  1839   "RTN","IBC NEHLT",117 ,0)
  1840    ... ; Eff ective Dat e
  1841   "RTN","IBC NEHLT",118 ,0)
  1842    ... S IBC NADT=$G(IB SEG(4))
  1843   "RTN","IBC NEHLT",119 ,0)
  1844    .. ;
  1845   "RTN","IBC NEHLT",120 ,0)
  1846    .. I SEG= "ZP0" D
  1847   "RTN","IBC NEHLT",121 ,0)
  1848    ... S ID= $$DECHL7^I BCNEHL2(IB SEG(3)),NE WID=$$DECH L7^IBCNEHL 2(IBSEG(4) )
  1849   "RTN","IBC NEHLT",122 ,0)
  1850    ... S DES C=$$DECHL7 ^IBCNEHL2( IBSEG(5)), HEDI=$$DEC HL7^IBCNEH L2(IBSEG(6 )),PEDI=$$ DECHL7^IBC NEHL2(IBSE G(7))
  1851   "RTN","IBC NEHLT",123 ,0)
  1852    .. ;
  1853   "RTN","IBC NEHLT",124 ,0)
  1854    .. I SEG= "ZPA" D
  1855   "RTN","IBC NEHLT",125 ,0)
  1856    ... S STA T=$S(IBSEG (4)="Y":1, 1:0)
  1857   "RTN","IBC NEHLT",126 ,0)
  1858    ... S TSS N=IBSEG(5) ,REQSUB=IB SEG(7)
  1859   "RTN","IBC NEHLT",127 ,0)
  1860    ... S FSV DY=IBSEG(8 ),PSVDY=IB SEG(9)
  1861   "RTN","IBC NEHLT",128 ,0)
  1862    ... S TRU STED=$S(IB SEG(10)="N ":0,1:1)
  1863   "RTN","IBC NEHLT",129 ,0)
  1864    ... D PFI L
  1865   "RTN","IBC NEHLT",130 ,0)
  1866    Q
  1867   "RTN","IBC NEHLT",131 ,0)
  1868    ;
  1869   "RTN","IBC NEHLT",132 ,0)
  1870   PFIL ;  Pa yer Table  Filer
  1871   "RTN","IBC NEHLT",133 ,0)
  1872    ;  Set th e action:
  1873   "RTN","IBC NEHLT",134 ,0)
  1874    ;     MAD =Add, MUP= Update, MD C=Deactiva te, MAC=Re activate
  1875   "RTN","IBC NEHLT",135 ,0)
  1876    N OLDAF,O LDTF
  1877   "RTN","IBC NEHLT",136 ,0)
  1878    S IBCNADT =$$FMDATE^ HLFNC(IBCN ADT)
  1879   "RTN","IBC NEHLT",137 ,0)
  1880    I IBCNADT ="" S IBCN ADT=$$NOW^ XLFDT()
  1881   "RTN","IBC NEHLT",138 ,0)
  1882    ;  If the  action is  MAD - Add  the payer  as new
  1883   "RTN","IBC NEHLT",139 ,0)
  1884    ;  IB*582 /TAZ if th e action i s MUP and  the entry  doesn't ex ist, add t he payer a s new
  1885   "RTN","IBC NEHLT",140 ,0)
  1886    N IBNOK,I BAPP,IBID, IBDESC,IBS TR,IBCNTYP E
  1887   "RTN","IBC NEHLT",141 ,0)
  1888    S IBNOK=0 ,IBAPP=($T R(APP," ") =""),IBID= ($TR(ID,"  ")=""),IBD ESC=($TR(D ESC," ")=" "),IBNOK=I BAPP!IBID! IBDESC
  1889   "RTN","IBC NEHLT",142 ,0)
  1890    I IBNOK D   G PFILX
  1891   "RTN","IBC NEHLT",143 ,0)
  1892    . S IBCNT YPE=$S(IBC NACT="MAD" :"Add",IBC NACT="MUP" :"Update", IBCNACT="M DC":"Deact ivate",IBC NACT="MAC" :"Reactiva te",1:"Unk nown")
  1893   "RTN","IBC NEHLT",144 ,0)
  1894    . S MSG(1 )=IBCNTYPE _" ("_IBCN ACT_") act ion receiv ed. Payer  and/or App lication m ay be unkn own."
  1895   "RTN","IBC NEHLT",145 ,0)
  1896    . S MSG(2 )=""
  1897   "RTN","IBC NEHLT",146 ,0)
  1898    . S MSG(3 )="VA Nati onal : "_I D
  1899   "RTN","IBC NEHLT",147 ,0)
  1900    . S MSG(4 )="Payer N ame : "_DE SC
  1901   "RTN","IBC NEHLT",148 ,0)
  1902    . S MSG(5 )="Applica tion : "_A PP
  1903   "RTN","IBC NEHLT",149 ,0)
  1904    . S MSG(6 )=""
  1905   "RTN","IBC NEHLT",150 ,0)
  1906    . S MSG(7 )="Log a R emedy Tick et for thi s issue."
  1907   "RTN","IBC NEHLT",151 ,0)
  1908    . S MSG(8 )=""
  1909   "RTN","IBC NEHLT",152 ,0)
  1910    . S MSG(9 )="Please  include in  the Remed y Ticket t hat VISTA  did not re ceive the  required"
  1911   "RTN","IBC NEHLT",153 ,0)
  1912    . S MSG(1 0)="inform ation or t he accurat e informat ion to add /update th is Payer."
  1913   "RTN","IBC NEHLT",154 ,0)
  1914    . D MSG^I BCNEUT5($$ MGRP^IBCNE UT5(),"eIV  payer tab les may be  out of sy nch with m aster list ","MSG(")
  1915   "RTN","IBC NEHLT",155 ,0)
  1916    D FND I I EN<0 D MAD (DESC)
  1917   "RTN","IBC NEHLT",156 ,0)
  1918    ;
  1919   "RTN","IBC NEHLT",157 ,0)
  1920    S DESC=$E (DESC,1,80 )    ;rest riction of  the field  in the DD
  1921   "RTN","IBC NEHLT",158 ,0)
  1922    S DIC=$$R OOT^DILFD( FLN)
  1923   "RTN","IBC NEHLT",159 ,0)
  1924    S DR=".01 ///^S X=DE SC;.02//// ^S X=NEWID ;.05////^S  X=PEDI;.0 6////^S X= HEDI"
  1925   "RTN","IBC NEHLT",160 ,0)
  1926    ;
  1927   "RTN","IBC NEHLT",161 ,0)
  1928    ;  If new  payer, ad d the Date /Time crea ted
  1929   "RTN","IBC NEHLT",162 ,0)
  1930    I NPFLG S  DR=DR_";. 04///^S X= $$NOW^XLFD T()"
  1931   "RTN","IBC NEHLT",163 ,0)
  1932    S DIE=DIC ,DA=IEN D  ^DIE
  1933   "RTN","IBC NEHLT",164 ,0)
  1934    ;
  1935   "RTN","IBC NEHLT",165 ,0)
  1936    ;  Check  for applic ation
  1937   "RTN","IBC NEHLT",166 ,0)
  1938    S DIC="^I BE(365.13, ",DIC(0)=" X",X=APP D  ^DIC
  1939   "RTN","IBC NEHLT",167 ,0)
  1940    S AIEN=+Y  I AIEN<1  D
  1941   "RTN","IBC NEHLT",168 ,0)
  1942    . S DLAYG O=365.13,D IC(0)="L", DIC("P")=D LAYGO
  1943   "RTN","IBC NEHLT",169 ,0)
  1944    . S DIE=D IC,X=APP
  1945   "RTN","IBC NEHLT",170 ,0)
  1946    . K DD,DO
  1947   "RTN","IBC NEHLT",171 ,0)
  1948    . D FILE^ DICN
  1949   "RTN","IBC NEHLT",172 ,0)
  1950    . K DO
  1951   "RTN","IBC NEHLT",173 ,0)
  1952    . S AIEN= +Y
  1953   "RTN","IBC NEHLT",174 ,0)
  1954    ;
  1955   "RTN","IBC NEHLT",175 ,0)
  1956    S APIEN=$ O(^IBE(365 .12,IEN,1, "B",AIEN," "))
  1957   "RTN","IBC NEHLT",176 ,0)
  1958    I APIEN=" " D
  1959   "RTN","IBC NEHLT",177 ,0)
  1960    . S DLAYG O=365.121, DIC(0)="L" ,DIC("P")= DLAYGO,DA( 1)=IEN,X=A IEN
  1961   "RTN","IBC NEHLT",178 ,0)
  1962    . S DIC=" ^IBE(365.1 2,"_DA(1)_ ",1,",DIE= DIC
  1963   "RTN","IBC NEHLT",179 ,0)
  1964    . I '$D(^ IBE(365.12 ,IEN,1,0))  S ^IBE(36 5.12,IEN,1 ,0)="^365. 121P^^"
  1965   "RTN","IBC NEHLT",180 ,0)
  1966    . K DD,DO
  1967   "RTN","IBC NEHLT",181 ,0)
  1968    . D FILE^ DICN
  1969   "RTN","IBC NEHLT",182 ,0)
  1970    . K DO
  1971   "RTN","IBC NEHLT",183 ,0)
  1972    . S APIEN =+Y,NAFLG= 1
  1973   "RTN","IBC NEHLT",184 ,0)
  1974    ; get cur rent value s for Acti ve and Tru sted flags
  1975   "RTN","IBC NEHLT",185 ,0)
  1976    S OLDAF=$ P(^IBE(365 .12,IEN,1, APIEN,0),U ,2),OLDTF= $P(^IBE(36 5.12,IEN,1 ,APIEN,0), U,7)
  1977   "RTN","IBC NEHLT",186 ,0)
  1978    S DA(1)=I EN,DA=APIE N,DIC="^IB E(365.12," _DA(1)_",1 ,",DR=""
  1979   "RTN","IBC NEHLT",187 ,0)
  1980    ;
  1981   "RTN","IBC NEHLT",188 ,0)
  1982    I IBCNACT ="MDC" S D R=DR_".11/ //^S X=1;. 12////^S X =IBCNADT;" ,STAT=0
  1983   "RTN","IBC NEHLT",189 ,0)
  1984    I IBCNACT ="MAC" S D R=DR_".11/ //^S X=0;. 12///@;"
  1985   "RTN","IBC NEHLT",190 ,0)
  1986    S DR=DR_" .02///^S X =STAT;.06/ //^S X=$$N OW^XLFDT() ;.07///^S  X=TRUSTED"
  1987   "RTN","IBC NEHLT",191 ,0)
  1988    I IBCNACT '="MDC" S  DR=DR_";.0 8///^S X=R EQSUB;.1// /^S X=TSSN ;.14///^S  X=FSVDY;.1 5///^S X=P SVDY"
  1989   "RTN","IBC NEHLT",192 ,0)
  1990    ;
  1991   "RTN","IBC NEHLT",193 ,0)
  1992    ;  If new  applicati on, add th e Date/Tim e created
  1993   "RTN","IBC NEHLT",194 ,0)
  1994    I NAFLG S  DR=DR_";. 13///^S X= $$NOW^XLFD T()"
  1995   "RTN","IBC NEHLT",195 ,0)
  1996    ;
  1997   "RTN","IBC NEHLT",196 ,0)
  1998    S DIE=DIC  D ^DIE
  1999   "RTN","IBC NEHLT",197 ,0)
  2000    ; Update  flag logs
  2001   "RTN","IBC NEHLT",198 ,0)
  2002    I STAT'=O LDAF D UPD LOG("A",ST AT,IEN,API EN)
  2003   "RTN","IBC NEHLT",199 ,0)
  2004    I TRUSTED '=OLDTF D  UPDLOG("T" ,TRUSTED,I EN,APIEN)
  2005   "RTN","IBC NEHLT",200 ,0)
  2006    I IBCNACT ="MDC" D M DC Q
  2007   "RTN","IBC NEHLT",201 ,0)
  2008   PFILX ;
  2009   "RTN","IBC NEHLT",202 ,0)
  2010    Q
  2011   "RTN","IBC NEHLT",203 ,0)
  2012    ;
  2013   "RTN","IBC NEHLT",204 ,0)
  2014   TFIL ;  No n Payer Ta bles Filer
  2015   "RTN","IBC NEHLT",205 ,0)
  2016    ; Input:  DESC  - Fi eld Number
  2017   "RTN","IBC NEHLT",206 ,0)
  2018    ;         ID    - Fi eld Value
  2019   "RTN","IBC NEHLT",207 ,0)
  2020    ;         FLN   - Fi le Number
  2021   "RTN","IBC NEHLT",208 ,0)
  2022    N DA,DIC, DIE,DLAYGO ,DR,EXTRAC T,IEN,MAX, XX,X,Y   ; IB*2.0*549  - Added D A,DIE,DR,E XTRACT,XX
  2023   "RTN","IBC NEHLT",209 ,0)
  2024    ;
  2025   "RTN","IBC NEHLT",210 ,0)
  2026    ; store t he FILENAM E, FIELDNA ME and VAL UE if the  APP is IIV  and FLN i s 350.9.   - IB*2.0*5 06
  2027   "RTN","IBC NEHLT",211 ,0)
  2028    ; For fil e #350.9,  DESC repre sents the  FIELD NUMB ER and ID  represents  the VALUE .
  2029   "RTN","IBC NEHLT",212 ,0)
  2030    I APP="II V",FLN=350 .9 D  Q
  2031   "RTN","IBC NEHLT",213 ,0)
  2032    . S DIE=F LN,DA=1,DR =DESC_"/// "_ID
  2033   "RTN","IBC NEHLT",214 ,0)
  2034    . D ^DIE
  2035   "RTN","IBC NEHLT",215 ,0)
  2036    ;
  2037   "RTN","IBC NEHLT",216 ,0)
  2038    ; IB*2.0* 549 Added  if stateme nt 
  2039   "RTN","IBC NEHLT",217 ,0)
  2040    I APP="II V",FLN=350 .9002 D  Q
  2041   "RTN","IBC NEHLT",218 ,0)
  2042    . S EXTRA CT=$E(DESC ,1,4)                     ; Eith er "Buff"  or "Appt"
  2043   "RTN","IBC NEHLT",219 ,0)
  2044    . S XX=$S (EXTRACT=" Buff":1,EX TRACT="App t":2,1:3)
  2045   "RTN","IBC NEHLT",220 ,0)
  2046    . S DESC= $E(DESC,5, 99)                       ; Fiel d number
  2047   "RTN","IBC NEHLT",221 ,0)
  2048    . S DA(1) =1
  2049   "RTN","IBC NEHLT",222 ,0)
  2050    . S DA=$O (^IBE(350. 9,1,51.17, "B",XX,"") )   ; Find  correct m ultiple
  2051   "RTN","IBC NEHLT",223 ,0)
  2052    . ;
  2053   "RTN","IBC NEHLT",224 ,0)
  2054    . ; File  the new va lue
  2055   "RTN","IBC NEHLT",225 ,0)
  2056    . S DIE=" ^IBE(350.9 ,1,51.17,"
  2057   "RTN","IBC NEHLT",226 ,0)
  2058    . S DR=DE SC_"///"_I D
  2059   "RTN","IBC NEHLT",227 ,0)
  2060    . D ^DIE
  2061   "RTN","IBC NEHLT",228 ,0)
  2062    ;
  2063   "RTN","IBC NEHLT",229 ,0)
  2064    ;IB*582/T AZ - Add n ew entries  and updat e existing  entries
  2065   "RTN","IBC NEHLT",230 ,0)
  2066    ;
  2067   "RTN","IBC NEHLT",231 ,0)
  2068    S DIC(0)= "X",X=ID,D IC=$$ROOT^ DILFD(FLN)
  2069   "RTN","IBC NEHLT",232 ,0)
  2070    D ^DIC S  IEN=+Y
  2071   "RTN","IBC NEHLT",233 ,0)
  2072    ; don't u pdate exis ting entri es
  2073   "RTN","IBC NEHLT",234 ,0)
  2074    ;I IEN>0  Q
  2075   "RTN","IBC NEHLT",235 ,0)
  2076    ;Add new  entry to t able
  2077   "RTN","IBC NEHLT",236 ,0)
  2078    I IEN<1 D
  2079   "RTN","IBC NEHLT",237 ,0)
  2080    . S DLAYG O=FLN,DIC( 0)="L"
  2081   "RTN","IBC NEHLT",238 ,0)
  2082    . K DD,DO  D FILE^DI CN K DO
  2083   "RTN","IBC NEHLT",239 ,0)
  2084    ;
  2085   "RTN","IBC NEHLT",240 ,0)
  2086    ;Update D escription
  2087   "RTN","IBC NEHLT",241 ,0)
  2088    ;
  2089   "RTN","IBC NEHLT",242 ,0)
  2090    D FIELD^D ID(FLN,.02 ,,"FIELD L ENGTH","MA X")
  2091   "RTN","IBC NEHLT",243 ,0)
  2092    I MAX("FI ELD LENGTH ")>0 S DES C=$E(DESC, 1,MAX("FIE LD LENGTH" )) ; restr iction of  the field  in the DD
  2093   "RTN","IBC NEHLT",244 ,0)
  2094    ; add new  entry to  the table
  2095   "RTN","IBC NEHLT",245 ,0)
  2096    ;S DLAYGO =FLN,DIC(0 )="L",DIC( "DR")=".02 ///"_DESC
  2097   "RTN","IBC NEHLT",246 ,0)
  2098    ;S DLAYGO =FLN,DIC(0 )="L",DIC( "DR")=".02 ///^S X=DE SC"
  2099   "RTN","IBC NEHLT",247 ,0)
  2100    ;K DD,DO  D FILE^DIC N K DO
  2101   "RTN","IBC NEHLT",248 ,0)
  2102    S DIE=DIC ,DA=IEN,DI C("DR")=". 02///^S X= DESC" D ^D IE
  2103   "RTN","IBC NEHLT",249 ,0)
  2104    Q
  2105   "RTN","IBC NEHLT",250 ,0)
  2106    ;
  2107   "RTN","IBC NEHLT",251 ,0)
  2108   MAD(X) ;   Add an ent ry
  2109   "RTN","IBC NEHLT",252 ,0)
  2110    ;IB*582/T AZ - Moved  check to  PFIL MAD i s called f or any rec ord that i s not foun d in the f ile.
  2111   "RTN","IBC NEHLT",253 ,0)
  2112    ;D FND
  2113   "RTN","IBC NEHLT",254 ,0)
  2114    ;I IEN>0  G MADX
  2115   "RTN","IBC NEHLT",255 ,0)
  2116    NEW DIC,D IE,DA,DLAY GO,Y,DR
  2117   "RTN","IBC NEHLT",256 ,0)
  2118    S DIC=$$R OOT^DILFD( FLN)
  2119   "RTN","IBC NEHLT",257 ,0)
  2120    S DLAYGO= FLN,DIC(0) ="L",DIC(" P")=DLAYGO ,DIE=DIC
  2121   "RTN","IBC NEHLT",258 ,0)
  2122    K DD,DO
  2123   "RTN","IBC NEHLT",259 ,0)
  2124    D FILE^DI CN
  2125   "RTN","IBC NEHLT",260 ,0)
  2126    K DO
  2127   "RTN","IBC NEHLT",261 ,0)
  2128    S IEN=+Y, NPFLG=1
  2129   "RTN","IBC NEHLT",262 ,0)
  2130   MADX ;
  2131   "RTN","IBC NEHLT",263 ,0)
  2132    Q
  2133   "RTN","IBC NEHLT",264 ,0)
  2134    ;
  2135   "RTN","IBC NEHLT",265 ,0)
  2136   FND ;  Fin d an exist ing Payer  entry
  2137   "RTN","IBC NEHLT",266 ,0)
  2138    NEW DIC,D IE,X,DA,DL AYGO,Y,DR
  2139   "RTN","IBC NEHLT",267 ,0)
  2140    S X=ID,DI C(0)="X",D ="C",DIC=$ $ROOT^DILF D(FLN)
  2141   "RTN","IBC NEHLT",268 ,0)
  2142    ;
  2143   "RTN","IBC NEHLT",269 ,0)
  2144    ;  Do a l ookup with  the "C" c ross-refer ence
  2145   "RTN","IBC NEHLT",270 ,0)
  2146    D IX^DIC
  2147   "RTN","IBC NEHLT",271 ,0)
  2148    S IEN=+Y
  2149   "RTN","IBC NEHLT",272 ,0)
  2150    Q
  2151   "RTN","IBC NEHLT",273 ,0)
  2152    ;
  2153   "RTN","IBC NEHLT",274 ,0)
  2154   MDC ;  Che ck for act ive transm issions an d cancel
  2155   "RTN","IBC NEHLT",275 ,0)
  2156    NEW STA,H IEN,RIEN,T QIEN
  2157   "RTN","IBC NEHLT",276 ,0)
  2158    F STA=1,2 ,4,6 S TQI EN="" D
  2159   "RTN","IBC NEHLT",277 ,0)
  2160    . F  S TQ IEN=$O(^IB CN(365.1," AC",STA,TQ IEN)) Q:TQ IEN=""  D
  2161   "RTN","IBC NEHLT",278 ,0)
  2162    .. ;
  2163   "RTN","IBC NEHLT",279 ,0)
  2164    .. ;  If  the record  doesn't m atch the p ayer, quit
  2165   "RTN","IBC NEHLT",280 ,0)
  2166    .. I $P(^ IBCN(365.1 ,TQIEN,0), U,3)'=IEN  Q
  2167   "RTN","IBC NEHLT",281 ,0)
  2168    .. ;
  2169   "RTN","IBC NEHLT",282 ,0)
  2170    .. ;  Set  the statu s to 'Canc elled'
  2171   "RTN","IBC NEHLT",283 ,0)
  2172    .. D SST^ IBCNEUT2(T QIEN,7)
  2173   "RTN","IBC NEHLT",284 ,0)
  2174    .. ;
  2175   "RTN","IBC NEHLT",285 ,0)
  2176    .. ;  If  a buffer e ntry, set  to ! (bang )
  2177   "RTN","IBC NEHLT",286 ,0)
  2178    .. S BUFF =$P(^IBCN( 365.1,TQIE N,0),U,5)
  2179   "RTN","IBC NEHLT",287 ,0)
  2180    .. I BUFF '="" D BUF F^IBCNEUT2 (BUFF,17)
  2181   "RTN","IBC NEHLT",288 ,0)
  2182    .. ;
  2183   "RTN","IBC NEHLT",289 ,0)
  2184    .. ;  Cha nge any re sponses st atus also
  2185   "RTN","IBC NEHLT",290 ,0)
  2186    .. S HIEN =0 F  S HI EN=$O(^IBC N(365.1,TQ IEN,2,HIEN )) Q:'HIEN   D
  2187   "RTN","IBC NEHLT",291 ,0)
  2188    ... S RIE N=$P(^IBCN (365.1,TQI EN,2,HIEN, 0),U,3)
  2189   "RTN","IBC NEHLT",292 ,0)
  2190    ... ;  If  the Respo nse status  is 'Respo nse Receiv ed', don't  change it
  2191   "RTN","IBC NEHLT",293 ,0)
  2192    ... I $P( ^IBCN(365, RIEN,0),U, 6)=3 Q
  2193   "RTN","IBC NEHLT",294 ,0)
  2194    ... D RSP ^IBCNEUT2( RIEN,7)
  2195   "RTN","IBC NEHLT",295 ,0)
  2196    Q
  2197   "RTN","IBC NEHLT",296 ,0)
  2198    ;
  2199   "RTN","IBC NEHLT",297 ,0)
  2200   UPDLOG(FLA G,VALUE,PI EN,APIEN)  ; Update a ctive/trus ted flag l ogs
  2201   "RTN","IBC NEHLT",298 ,0)
  2202    ; FLAG -  "A" for Ac tive flag,  "T" for T rusted fla g
  2203   "RTN","IBC NEHLT",299 ,0)
  2204    ; VALUE -  new flag  value (0 o r 1)
  2205   "RTN","IBC NEHLT",300 ,0)
  2206    ; PIEN -  ien in PAY ER file (3 65.12)
  2207   "RTN","IBC NEHLT",301 ,0)
  2208    ; APIEN -  ien in AP PLICATION  sub-file ( 365.121)
  2209   "RTN","IBC NEHLT",302 ,0)
  2210    ;
  2211   "RTN","IBC NEHLT",303 ,0)
  2212    N FILE,IE NSTR,UPDT
  2213   "RTN","IBC NEHLT",304 ,0)
  2214    I $G(FLAG )=""!($G(V ALUE)="")  Q
  2215   "RTN","IBC NEHLT",305 ,0)
  2216    I +$G(PIE N)=0!(+$G( APIEN)=0)  Q
  2217   "RTN","IBC NEHLT",306 ,0)
  2218    S FILE=$S (FLAG="A": "365.1212" ,FLAG="T": "365.1213" ,1:"") I F ILE="" Q
  2219   "RTN","IBC NEHLT",307 ,0)
  2220    S IENSTR= "+1,"_APIE N_","_PIEN _","
  2221   "RTN","IBC NEHLT",308 ,0)
  2222    S UPDT(FI LE,IENSTR, .01)=$$NOW ^XLFDT()
  2223   "RTN","IBC NEHLT",309 ,0)
  2224    S UPDT(FI LE,IENSTR, .02)=VALUE
  2225   "RTN","IBC NEHLT",310 ,0)
  2226    D UPDATE^ DIE("E","U PDT")
  2227   "RTN","IBC NEHLT",311 ,0)
  2228    Q
  2229   "RTN","IBC NEQU")
  2230   0^3^B12676 8253^B1260 99513
  2231   "RTN","IBC NEQU",1,0)
  2232   IBCNEQU ;D AOU/BHS -  eIV REQUES T ELECTRON IC INSURAN CE INQUIRY  ;24-JUN-2 002
  2233   "RTN","IBC NEQU",2,0)
  2234    ;;2.0;INT EGRATED BI LLING;**18 4,271,416, 438,497,58 2**;21-MAR -94;Build  77
  2235   "RTN","IBC NEQU",3,0)
  2236    ;;Per VHA  Directive  2004-038,  this rout ine should  not be mo dified.
  2237   "RTN","IBC NEQU",4,0)
  2238    ;
  2239   "RTN","IBC NEQU",5,0)
  2240    ; eIV - I nsurance V erificatio n Interfac e
  2241   "RTN","IBC NEQU",6,0)
  2242    ;
  2243   "RTN","IBC NEQU",7,0)
  2244    ; Must ca ll from EN
  2245   "RTN","IBC NEQU",8,0)
  2246    Q
  2247   "RTN","IBC NEQU",9,0)
  2248    ;
  2249   "RTN","IBC NEQU",10,0 )
  2250   EN ; Entry  pt
  2251   "RTN","IBC NEQU",11,0 )
  2252    ; Init va rs
  2253   "RTN","IBC NEQU",12,0 )
  2254    N DFN,X,P OP,IBFASTX T,VALMCNT, VALMBG,VAL MHDR,VALMB CK,IDUZ
  2255   "RTN","IBC NEQU",13,0 )
  2256    ;
  2257   "RTN","IBC NEQU",14,0 )
  2258   EN1 I $G(I BFASTXT) G  ENX
  2259   "RTN","IBC NEQU",15,0 )
  2260    S DFN=$$P AT I 'DFN  G ENX
  2261   "RTN","IBC NEQU",16,0 )
  2262    D EN^VALM ("IBCNE RE QUEST INS  INQUIRY LI ST")
  2263   "RTN","IBC NEQU",17,0 )
  2264    G EN1
  2265   "RTN","IBC NEQU",18,0 )
  2266    ;
  2267   "RTN","IBC NEQU",19,0 )
  2268   ENX ; EN e xit pt
  2269   "RTN","IBC NEQU",20,0 )
  2270    Q
  2271   "RTN","IBC NEQU",21,0 )
  2272    ;
  2273   "RTN","IBC NEQU",22,0 )
  2274   INIT ; --  set up ini tial varia bles
  2275   "RTN","IBC NEQU",23,0 )
  2276    S VALMCNT =0,VALMBG= 1,IDUZ=DUZ
  2277   "RTN","IBC NEQU",24,0 )
  2278    K ^TMP("I BCNEQU",$J ),^TMP("IB CNEQUX",$J ),^TMP("IB CNEQUDTS", $J)
  2279   "RTN","IBC NEQU",25,0 )
  2280    D HDR
  2281   "RTN","IBC NEQU",26,0 )
  2282    D BLD(DFN )
  2283   "RTN","IBC NEQU",27,0 )
  2284    ;
  2285   "RTN","IBC NEQU",28,0 )
  2286   INITX ; IN IT exit pt
  2287   "RTN","IBC NEQU",29,0 )
  2288    Q
  2289   "RTN","IBC NEQU",30,0 )
  2290    ;
  2291   "RTN","IBC NEQU",31,0 )
  2292   HDR ; -- s creen head er for ini tial scree n
  2293   "RTN","IBC NEQU",32,0 )
  2294    N VA,VAER R,%DT,II
  2295   "RTN","IBC NEQU",33,0 )
  2296    D PID^VAD PT
  2297   "RTN","IBC NEQU",34,0 )
  2298    S VALMHDR (1)="Reque st Electro nic Insura nce Inquir y for Pati ent: "_$E( $P($G(^DPT (DFN,0)),U ),1,20)_"  "_$E($G(^( 0)),1)_VA( "BID")
  2299   "RTN","IBC NEQU",35,0 )
  2300    S VALMHDR (2)=" "
  2301   "RTN","IBC NEQU",36,0 )
  2302    S VALMHDR (3)=" "
  2303   "RTN","IBC NEQU",37,0 )
  2304    S II=1
  2305   "RTN","IBC NEQU",38,0 )
  2306    I +$$BUFF ER^IBCNBU1 (DFN) S II =II+1,VALM HDR(II)="* ** Patient  has Insur ance Buffe r Records"
  2307   "RTN","IBC NEQU",39,0 )
  2308    I $P($G(^ DPT(DFN,.3 5)),U)'=""  S II=II+1 ,VALMHDR(I I)="*** Da te of Deat h: "_$$FMT E^XLFDT($P ($G(^DPT(D FN,.35)),U )\1,"5Z")
  2309   "RTN","IBC NEQU",40,0 )
  2310    Q
  2311   "RTN","IBC NEQU",41,0 )
  2312    ;
  2313   "RTN","IBC NEQU",42,0 )
  2314   HELP ; --  help code
  2315   "RTN","IBC NEQU",43,0 )
  2316    D FULL^VA LM1
  2317   "RTN","IBC NEQU",44,0 )
  2318    W @IOF
  2319   "RTN","IBC NEQU",45,0 )
  2320    W !,"This  screen li sts all el igible (no n-Medicaid ) Insuranc e policies "
  2321   "RTN","IBC NEQU",46,0 )
  2322    W !,"for  the patien t.  Select ing an ent ry in this  list crea tes an Ins urance Buf fer"
  2323   "RTN","IBC NEQU",47,0 )
  2324    W !,"entr y with Sou rce 'eIV'  and Overri de Freshne ss Flag 'Y es'.  Sett ing this f lag"
  2325   "RTN","IBC NEQU",48,0 )
  2326    W !,"is d esigned to  force the  eIV extra ct to atte mpt to cre ate an ins urance"
  2327   "RTN","IBC NEQU",49,0 )
  2328    W !,"inqu iry based  on this en try."
  2329   "RTN","IBC NEQU",50,0 )
  2330    W !!,"Ent ries with  an asteris k (*) prec eding the  Insurance  Co name al ready exis t in"
  2331   "RTN","IBC NEQU",51,0 )
  2332    W !,"the  Insurance  Buffer wit h the exac t same nam e, the exa ct same Gr oup Number ,"
  2333   "RTN","IBC NEQU",52,0 )
  2334    W !,"and  the Overri de Freshne ss Flag se t to 'Yes' .  Selecti ng an entr y with an"
  2335   "RTN","IBC NEQU",53,0 )
  2336    W !,"aste risk (*) w ill create  a duplica te entry i n the Insu rance Buff er file fo r"
  2337   "RTN","IBC NEQU",54,0 )
  2338    W !,"the  patient."
  2339   "RTN","IBC NEQU",55,0 )
  2340    D PAUSE^V ALM1
  2341   "RTN","IBC NEQU",56,0 )
  2342    S VALMBCK ="R"
  2343   "RTN","IBC NEQU",57,0 )
  2344    Q
  2345   "RTN","IBC NEQU",58,0 )
  2346    ;
  2347   "RTN","IBC NEQU",59,0 )
  2348   EXIT ; --  exit code
  2349   "RTN","IBC NEQU",60,0 )
  2350    K ^TMP("I BCNEQU",$J ),^TMP("IB CNEQUX",$J )
  2351   "RTN","IBC NEQU",61,0 )
  2352    Q
  2353   "RTN","IBC NEQU",62,0 )
  2354    ;
  2355   "RTN","IBC NEQU",63,0 )
  2356   PAT() ; Pr ompt user  to select  a patient
  2357   "RTN","IBC NEQU",64,0 )
  2358    ; Init va rs
  2359   "RTN","IBC NEQU",65,0 )
  2360    N DIC,X,Y ,DISYS,%H, %I,DUOUT,D TOUT
  2361   "RTN","IBC NEQU",66,0 )
  2362    ;
  2363   "RTN","IBC NEQU",67,0 )
  2364    W !
  2365   "RTN","IBC NEQU",68,0 )
  2366    ; Exclude  non-Veter ans
  2367   "RTN","IBC NEQU",69,0 )
  2368    S DIC(0)= "AEQMN"
  2369   "RTN","IBC NEQU",70,0 )
  2370    S DIC("S" )="I $G(^( ""VET""))= ""Y"",('$P ($G(^(0)), U,21))",DI C="^DPT("
  2371   "RTN","IBC NEQU",71,0 )
  2372    D ^DIC
  2373   "RTN","IBC NEQU",72,0 )
  2374    I $D(DUOU T)!$D(DTOU T)!(Y<1) Q  ""
  2375   "RTN","IBC NEQU",73,0 )
  2376    ;
  2377   "RTN","IBC NEQU",74,0 )
  2378    Q +Y
  2379   "RTN","IBC NEQU",75,0 )
  2380    ;
  2381   "RTN","IBC NEQU",76,0 )
  2382   BLD(DFN) ;  Build lis t of all i nsurance f or patient
  2383   "RTN","IBC NEQU",77,0 )
  2384    N IBCT,IB INS,IBDATA 0,IBDATA1, IBDATA2,II ,STR,IBINS IEN,IBINAM E,IBHOLD
  2385   "RTN","IBC NEQU",78,0 )
  2386    N VNODT,X ,POP,IBBUF ,IBBUFNM,I BIEN,IBBUF DT,TMPNM,G RPNUM,SFAN AME
  2387   "RTN","IBC NEQU",79,0 )
  2388    ;
  2389   "RTN","IBC NEQU",80,0 )
  2390    K ^TMP("I BCNEQU",$J ),^TMP("IB CNEQUX",$J )
  2391   "RTN","IBC NEQU",81,0 )
  2392    ;
  2393   "RTN","IBC NEQU",82,0 )
  2394    S (IBCT,V ALMCNT)=0
  2395   "RTN","IBC NEQU",83,0 )
  2396    ;
  2397   "RTN","IBC NEQU",84,0 )
  2398    ; Determi ne if buff er entries  exist for  this DFN  and build  array by n ame
  2399   "RTN","IBC NEQU",85,0 )
  2400    S IBIEN=0
  2401   "RTN","IBC NEQU",86,0 )
  2402    F  S IBIE N=$O(^IBA( 355.33,"C" ,DFN,IBIEN )) Q:'IBIE N  D
  2403   "RTN","IBC NEQU",87,0 )
  2404    . S IBBUF DT=$G(^IBA (355.33,IB IEN,0))
  2405   "RTN","IBC NEQU",88,0 )
  2406    . ; Inclu de E statu s only
  2407   "RTN","IBC NEQU",89,0 )
  2408    . I $P(IB BUFDT,U,4) '="E" Q
  2409   "RTN","IBC NEQU",90,0 )
  2410    . S IBBUF NM=$$TRIM^ XLFSTR($P( $G(^IBA(35 5.33,IBIEN ,20)),U))
  2411   "RTN","IBC NEQU",91,0 )
  2412    . I IBBUF NM="" Q
  2413   "RTN","IBC NEQU",92,0 )
  2414    . ;S GRPN UM=$$TRIM^ XLFSTR($P( $G(^IBA(35 5.33,IBIEN ,40)),U,3) )
  2415   "RTN","IBC NEQU",93,0 )
  2416    . S GRPNU M=$$TRIM^X LFSTR($P($ G(^IBA(355 .33,IBIEN, 90)),U,2))   ; ib*2*4 97  get gr oup number  from it's  new locat ion
  2417   "RTN","IBC NEQU",94,0 )
  2418    . S IBBUF (IBBUFNM,"  "_GRPNUM) =""
  2419   "RTN","IBC NEQU",95,0 )
  2420    . Q
  2421   "RTN","IBC NEQU",96,0 )
  2422    ;
  2423   "RTN","IBC NEQU",97,0 )
  2424    ; Populat e IBINS ar ray with P atient Ins urance rec ords
  2425   "RTN","IBC NEQU",98,0 )
  2426    D ALL^IBC NS1(DFN,"I BINS")
  2427   "RTN","IBC NEQU",99,0 )
  2428    I $G(IBIN S(0)) S II =0 F  S II =$O(IBINS( II)) Q:'II   D
  2429   "RTN","IBC NEQU",100, 0)
  2430    . S IBDAT A0=$G(IBIN S(II,0))
  2431   "RTN","IBC NEQU",101, 0)
  2432    . S IBDAT A1=$G(IBIN S(II,1))
  2433   "RTN","IBC NEQU",102, 0)
  2434    . S IBDAT A2=$G(^IBA (355.3,+$P (IBDATA0,U ,18),0))
  2435   "RTN","IBC NEQU",103, 0)
  2436    . S GRPNU M=$$TRIM^X LFSTR($P($ G(^IBA(355 .3,+$P(IBD ATA0,U,18) ,2)),U,2))   ; ib*2*4 97  get gr oup number  from it's  new locat ion
  2437   "RTN","IBC NEQU",104, 0)
  2438    . ;S GRPN UM=$$TRIM^ XLFSTR($P( GRPNUM,U,2 ))
  2439   "RTN","IBC NEQU",105, 0)
  2440    . ;S GRPN UM=$$TRIM^ XLFSTR($P( IBDATA2,U, 4))
  2441   "RTN","IBC NEQU",106, 0)
  2442    . S IBINS IEN=+$P(IB DATA0,U)
  2443   "RTN","IBC NEQU",107, 0)
  2444    . Q:'IBIN SIEN!'$D(^ DIC(36,IBI NSIEN,0))
  2445   "RTN","IBC NEQU",108, 0)
  2446    . S IBINA ME=$P($G(^ DIC(36,IBI NSIEN,0)), U)
  2447   "RTN","IBC NEQU",109, 0)
  2448    . S TMPNM =$$TRIM^XL FSTR(IBINA ME)
  2449   "RTN","IBC NEQU",110, 0)
  2450    . ; Filte r Ins Co's  by name -  currently  filter Me dicaid
  2451   "RTN","IBC NEQU",111, 0)
  2452    . I $$EXC LUDE^IBCNE UT4(TMPNM)  Q
  2453   "RTN","IBC NEQU",112, 0)
  2454    . S IBCT= IBCT+1
  2455   "RTN","IBC NEQU",113, 0)
  2456    . S STR=" "
  2457   "RTN","IBC NEQU",114, 0)
  2458    . S STR=$ $SETFLD^VA LM1(IBCT,S TR,"NUMBER ")
  2459   "RTN","IBC NEQU",115, 0)
  2460    . ; Updat e IBINAME  if found i n buffer a lready
  2461   "RTN","IBC NEQU",116, 0)
  2462    . S IBINA ME=$S($D(I BBUF(TMPNM ," "_GRPNU M)):"*",1: "")_IBINAM E
  2463   "RTN","IBC NEQU",117, 0)
  2464    . S STR=$ $SETFLD^VA LM1(IBINAM E,STR,"NAM E")
  2465   "RTN","IBC NEQU",118, 0)
  2466    . S STR=$ $SETFLD^VA LM1($E($P( IBDATA0,U, 2),1,14),S TR,"POLICY ")
  2467   "RTN","IBC NEQU",119, 0)
  2468    . S IBHOL D=$P(IBDAT A0,U,6),ST R=$$SETFLD ^VALM1($S( IBHOLD="v" :"SELF",IB HOLD="s":" SPOUSE",IB HOLD="o":" OTHER",1:" UNKNOWN"), STR,"HOLDE R")
  2469   "RTN","IBC NEQU",120, 0)
  2470    . S STR=$ $SETFLD^VA LM1($E($$G RP^IBCNS($ P(IBDATA0, U,18)),1,1 0),STR,"GR OUP")
  2471   "RTN","IBC NEQU",121, 0)
  2472    . S STR=$ $SETFLD^VA LM1($$FMTE ^XLFDT($P( IBDATA0,U, 8),"5Z"),S TR,"EFFDT" )
  2473   "RTN","IBC NEQU",122, 0)
  2474    . S STR=$ $SETFLD^VA LM1($$FMTE ^XLFDT($P( IBDATA0,U, 4),"5Z"),S TR,"EXPIRE ")
  2475   "RTN","IBC NEQU",123, 0)
  2476    . S STR=$ $SETFLD^VA LM1($E($P( $G(^IBE(35 5.1,+$P(IB DATA2,U,9) ,0)),U),1, 8),STR,"TY PE")
  2477   "RTN","IBC NEQU",124, 0)
  2478    . S STR=$ $SETFLD^VA LM1($P($G( ^IBE(355.1 ,+$P(IBDAT A2,U,9),0) ),U),STR," TYPEPOL")
  2479   "RTN","IBC NEQU",125, 0)
  2480    . S STR=$ $SETFLD^VA LM1($E($P( $G(^VA(200 ,+$P(IBDAT A1,U,4),0) ),U),1,15) ,STR,"VERI FIED BY")
  2481   "RTN","IBC NEQU",126, 0)
  2482    . S STR=$ $SETFLD^VA LM1($$FMTE ^XLFDT($P( IBDATA1,U, 3),"5Z"),S TR,"VERIFI ED ON")
  2483   "RTN","IBC NEQU",127, 0)
  2484    . S STR=$ $SETFLD^VA LM1($$YN($ P(IBDATA2, U,6)),STR, "PRECERT")
  2485   "RTN","IBC NEQU",128, 0)
  2486    . S STR=$ $SETFLD^VA LM1($$YN($ P(IBDATA2, U,5)),STR, "UR")
  2487   "RTN","IBC NEQU",129, 0)
  2488    . S STR=$ $SETFLD^VA LM1($$YN($ P(IBDATA0, U,20)),STR ,"COB")
  2489   "RTN","IBC NEQU",130, 0)
  2490    . D SET(S TR)
  2491   "RTN","IBC NEQU",131, 0)
  2492    . Q
  2493   "RTN","IBC NEQU",132, 0)
  2494    ;
  2495   "RTN","IBC NEQU",133, 0)
  2496    I 'IBCT D
  2497   "RTN","IBC NEQU",134, 0)
  2498    . S VALMC NT=VALMCNT +1
  2499   "RTN","IBC NEQU",135, 0)
  2500    . S ^TMP( "IBCNEQU", $J,VALMCNT ,0)=" "
  2501   "RTN","IBC NEQU",136, 0)
  2502    . S VALMC NT=VALMCNT +1
  2503   "RTN","IBC NEQU",137, 0)
  2504    . S ^TMP( "IBCNEQU", $J,VALMCNT ,0)="       No eligib le insuran ce policie s found."
  2505   "RTN","IBC NEQU",138, 0)
  2506    . Q
  2507   "RTN","IBC NEQU",139, 0)
  2508    ;
  2509   "RTN","IBC NEQU",140, 0)
  2510    S VNODT=$ P($G(^IBA( 354,DFN,60 )),U,1) I  VNODT D
  2511   "RTN","IBC NEQU",141, 0)
  2512    . S VALMC NT=VALMCNT +1
  2513   "RTN","IBC NEQU",142, 0)
  2514    . S ^TMP( "IBCNEQU", $J,VALMCNT ,0)=" "
  2515   "RTN","IBC NEQU",143, 0)
  2516    . S VALMC NT=VALMCNT +1
  2517   "RTN","IBC NEQU",144, 0)
  2518    . S ^TMP( "IBCNEQU", $J,VALMCNT ,0)="       Verificat ion of No  Coverage " _$$FMTE^XL FDT(VNODT, "5Z")_"."
  2519   "RTN","IBC NEQU",145, 0)
  2520    . Q
  2521   "RTN","IBC NEQU",146, 0)
  2522    ;
  2523   "RTN","IBC NEQU",147, 0)
  2524   BLDX ; BLD  exit pt
  2525   "RTN","IBC NEQU",148, 0)
  2526    Q
  2527   "RTN","IBC NEQU",149, 0)
  2528    ;
  2529   "RTN","IBC NEQU",150, 0)
  2530   SET(LINE)  ; -- set a rrays
  2531   "RTN","IBC NEQU",151, 0)
  2532    ; LINE -  line of te xt to disp lay
  2533   "RTN","IBC NEQU",152, 0)
  2534    S VALMCNT =VALMCNT+1
  2535   "RTN","IBC NEQU",153, 0)
  2536    S ^TMP("I BCNEQU",$J ,VALMCNT,0 )=LINE
  2537   "RTN","IBC NEQU",154, 0)
  2538    S ^TMP("I BCNEQU",$J ,"IDX",VAL MCNT,IBCT) =""
  2539   "RTN","IBC NEQU",155, 0)
  2540    S ^TMP("I BCNEQUX",$ J,IBCT)=VA LMCNT_U_DF N_U_II_U_I BINAME_U_I BDATA0
  2541   "RTN","IBC NEQU",156, 0)
  2542    S ^TMP("I BCNEQUX",$ J)=$G(^TMP ("IBCNEQUX ",$J))+1
  2543   "RTN","IBC NEQU",157, 0)
  2544    Q
  2545   "RTN","IBC NEQU",158, 0)
  2546    ;
  2547   "RTN","IBC NEQU",159, 0)
  2548   YN(X) ; --  convert 1  or 0 to y es/no/unkn own
  2549   "RTN","IBC NEQU",160, 0)
  2550    Q $S(X=0: "NO",X=1:" YES",1:"UN K")
  2551   "RTN","IBC NEQU",161, 0)
  2552    ;
  2553   "RTN","IBC NEQU",162, 0)
  2554   SELECT ; U ser select s insuranc e from lis t to be re confirmed
  2555   "RTN","IBC NEQU",163, 0)
  2556    N IBDATA, IBDPT,IBDA ,DIR,X,Y,D 0,DG,DIC,D ISYS,DIW,I ENS,IBELIG DT,IBERROR ,IBIEN,IBS YM
  2557   "RTN","IBC NEQU",164, 0)
  2558    ;
  2559   "RTN","IBC NEQU",165, 0)
  2560    D FULL^VA LM1
  2561   "RTN","IBC NEQU",166, 0)
  2562    S VALMBCK ="R"
  2563   "RTN","IBC NEQU",167, 0)
  2564    ;
  2565   "RTN","IBC NEQU",168, 0)
  2566    I '$O(^TM P("IBCNEQU X",$J,0))  D  G SELEC TX
  2567   "RTN","IBC NEQU",169, 0)
  2568    . W !!,"N o Insuranc e policies  to select ."
  2569   "RTN","IBC NEQU",170, 0)
  2570    . S DIR(0 )="E" D ^D IR K DIR
  2571   "RTN","IBC NEQU",171, 0)
  2572    . Q
  2573   "RTN","IBC NEQU",172, 0)
  2574    ;
  2575   "RTN","IBC NEQU",173, 0)
  2576    S (IBDPT, IBDA,IBERR OR)=""
  2577   "RTN","IBC NEQU",174, 0)
  2578    S IBDATA= $$SEL()
  2579   "RTN","IBC NEQU",175, 0)
  2580    S IBDPT=+ $P(IBDATA, U)       ;  Patient D FN
  2581   "RTN","IBC NEQU",176, 0)
  2582    S IBDA=+$ P(IBDATA,U ,2)      ;  2.312 ptr
  2583   "RTN","IBC NEQU",177, 0)
  2584    I +IBDPT, +IBDA D
  2585   "RTN","IBC NEQU",178, 0)
  2586    . S IBIEN =+$P(IBDAT A,U,4)      ; Ins Co  IEN (#36)
  2587   "RTN","IBC NEQU",179, 0)
  2588    . S IBSYM =$P($$INSE RROR^IBCNE UT3("I",IB IEN),"^",1 )
  2589   "RTN","IBC NEQU",180, 0)
  2590    . S ^TMP( "IBCNEQUDT S",$J)=1
  2591   "RTN","IBC NEQU",181, 0)
  2592    . D PT^IB CNEBF(IBDP T,IBDA,IBS YM,1,1,.IB ERROR)
  2593   "RTN","IBC NEQU",182, 0)
  2594    . ; Check  for error s
  2595   "RTN","IBC NEQU",183, 0)
  2596    . I $G(IB ERROR)'=""  W !!,"Ins urance Buf fer entry  could not  be created  due to er ror!  Plea se try aga in.",!
  2597   "RTN","IBC NEQU",184, 0)
  2598    . I $G(IB ERROR)=""  W !!,"Insu rance Buff er entry c reated!",!
  2599   "RTN","IBC NEQU",185, 0)
  2600    . S DIR(0 )="E" D ^D IR K DIR
  2601   "RTN","IBC NEQU",186, 0)
  2602    . K ^TMP( "IBCNEQUDT S",$J)
  2603   "RTN","IBC NEQU",187, 0)
  2604    ;
  2605   "RTN","IBC NEQU",188, 0)
  2606    I $P(IBDA TA,U,3)="~ NO PAYER"  D
  2607   "RTN","IBC NEQU",189, 0)
  2608    . W !!,"P ayer missi ng. Identi fication i nquiries n ot allowed ."    ; IB *2*416
  2609   "RTN","IBC NEQU",190, 0)
  2610    . S DIR(0 )="E" D ^D IR K DIR
  2611   "RTN","IBC NEQU",191, 0)
  2612    . Q
  2613   "RTN","IBC NEQU",192, 0)
  2614    ;
  2615   "RTN","IBC NEQU",193, 0)
  2616   SELECTX ;
  2617   "RTN","IBC NEQU",194, 0)
  2618    S VALMBCK ="R"
  2619   "RTN","IBC NEQU",195, 0)
  2620    Q
  2621   "RTN","IBC NEQU",196, 0)
  2622    ;
  2623   "RTN","IBC NEQU",197, 0)
  2624   SEL() ; Us er selects  insurance  from list
  2625   "RTN","IBC NEQU",198, 0)
  2626    N IBSELN, DIR,X,Y,DI RUT,DUOUT
  2627   "RTN","IBC NEQU",199, 0)
  2628    ;
  2629   "RTN","IBC NEQU",200, 0)
  2630    S IBSELN= ""
  2631   "RTN","IBC NEQU",201, 0)
  2632    ; Select  entry to r econfirm
  2633   "RTN","IBC NEQU",202, 0)
  2634    S DIR(0)= "NO^1:"_$G (^TMP("IBC NEQUX",$J) )_":0"
  2635   "RTN","IBC NEQU",203, 0)
  2636    S DIR("A" )="Select  entry to r equest ele ctronic in quiry"
  2637   "RTN","IBC NEQU",204, 0)
  2638    S DIR("?" ,1)="  Sel ect an ent ry to init iate an in surance in quiry."
  2639   "RTN","IBC NEQU",205, 0)
  2640    S DIR("?" ,2)="  If  entry cont ains an In surance Co  name, an  Insurance"
  2641   "RTN","IBC NEQU",206, 0)
  2642    S DIR("?" ,3)="  Buf fer entry  will be cr eated for  nightly ba tch extrac t."
  2643   "RTN","IBC NEQU",207, 0)
  2644    S DIR("?" )="  "
  2645   "RTN","IBC NEQU",208, 0)
  2646    D ^DIR K  DIR
  2647   "RTN","IBC NEQU",209, 0)
  2648    I $D(DIRU T)!$D(DUOU T)!(Y<1) G  SELX
  2649   "RTN","IBC NEQU",210, 0)
  2650    S IBSELN= $O(^TMP("I BCNEQU",$J ,"IDX",Y,0 ))
  2651   "RTN","IBC NEQU",211, 0)
  2652    I IBSELN  S IBSELN=$ P($G(^TMP( "IBCNEQUX" ,$J,IBSELN )),U,2,99)
  2653   "RTN","IBC NEQU",212, 0)
  2654    I $E($P(I BSELN,U,3) )="*" W !  D  S IBSEL N="" G SEL X
  2655   "RTN","IBC NEQU",213, 0)
  2656    .S DIR(0) ="EA"
  2657   "RTN","IBC NEQU",214, 0)
  2658    .S DIR("A ",1)=""
  2659   "RTN","IBC NEQU",215, 0)
  2660    .S DIR("A ",2)="Sele cted polic y has an e xisting bu ffer entry ."
  2661   "RTN","IBC NEQU",216, 0)
  2662    .S DIR("A ",3)="You  must first  process t he existin g buffer e ntry."
  2663   "RTN","IBC NEQU",217, 0)
  2664    .S DIR("A ")="Press  RETURN to  continue "  D ^DIR K  DIR W !
  2665   "RTN","IBC NEQU",218, 0)
  2666    .Q
  2667   "RTN","IBC NEQU",219, 0)
  2668    ;
  2669   "RTN","IBC NEQU",220, 0)
  2670    ; Get ser vice type  code
  2671   "RTN","IBC NEQU",221, 0)
  2672    D STC
  2673   "RTN","IBC NEQU",222, 0)
  2674    I X="^" S  IBSELN=""  G SELX  ;  '^' enter ed thus ba ckup a lev el & re-as k Insuranc e question
  2675   "RTN","IBC NEQU",223, 0)
  2676    ; Get eli gibility d ate
  2677   "RTN","IBC NEQU",224, 0)
  2678    S IBELIGD T=$$ELIGDT () I 'IBEL IGDT S IBS ELN="" G S ELX
  2679   "RTN","IBC NEQU",225, 0)
  2680    W !
  2681   "RTN","IBC NEQU",226, 0)
  2682    S DIR(0)= "Y"
  2683   "RTN","IBC NEQU",227, 0)
  2684    S DIR("A" )="Are you  sure you  want to re quest an i nsurance i nquiry"
  2685   "RTN","IBC NEQU",228, 0)
  2686    S DIR("B" )="NO"
  2687   "RTN","IBC NEQU",229, 0)
  2688    S DIR("?" ,1)="  If  yes, a req uest will  be created  for the n ightly bat ch."
  2689   "RTN","IBC NEQU",230, 0)
  2690    D ^DIR K  DIR
  2691   "RTN","IBC NEQU",231, 0)
  2692    I $D(DIRU T)!$D(DUOU T)!('Y) S  IBSELN=""
  2693   "RTN","IBC NEQU",232, 0)
  2694    ;
  2695   "RTN","IBC NEQU",233, 0)
  2696   SELX Q IBS ELN
  2697   "RTN","IBC NEQU",234, 0)
  2698    ;
  2699   "RTN","IBC NEQU",235, 0)
  2700   STC ; Ask  for servic e type cod e to send
  2701   "RTN","IBC NEQU",236, 0)
  2702    ; IB*582/ HN - Modif ied Defaul t Service  Type Code  to pull fr om the MCC F Billing  Parameters  File (350 .9,60.01)
  2703   "RTN","IBC NEQU",237, 0)
  2704    N DIR,X,Y
  2705   "RTN","IBC NEQU",238, 0)
  2706    ; IBEISTC  used as S TC variabl e
  2707   "RTN","IBC NEQU",239, 0)
  2708    S IBEISTC =""
  2709   "RTN","IBC NEQU",240, 0)
  2710    S DIR(0)= "PAO^365.0 13:EMZ",DI R("A")="En ter Servic e Type Cod e: "
  2711   "RTN","IBC NEQU",241, 0)
  2712    S DIR("B" )=$$GET1^D IQ(350.9,1 _",",60.01 ,"E")
  2713   "RTN","IBC NEQU",242, 0)
  2714    S DIR("?? ")="^D HEL PSTC2^IBCN EQU"
  2715   "RTN","IBC NEQU",243, 0)
  2716   STCEN ; In tital and  re-enteran t tag upon  error
  2717   "RTN","IBC NEQU",244, 0)
  2718    D ^DIR Q: X="^"
  2719   "RTN","IBC NEQU",245, 0)
  2720    ; Check t o verify c ode is act ive, if no t, display  error and  ask again
  2721   "RTN","IBC NEQU",246, 0)
  2722    I $P($G(Y (0)),U,3)' ="" W !,"C ode select ed is not  an active  code - ple ase select  another c ode.",! G  STCEN
  2723   "RTN","IBC NEQU",247, 0)
  2724    ; If vali d STC ente red, set I BEISTC to  be STC IEN . If no co de entered , default  to service  code 30
  2725   "RTN","IBC NEQU",248, 0)
  2726    ;S IBEIST C=$S(+Y>0: $P(Y,U,1), 1:$O(^IBE( 365.013,"B ",30,"")))
  2727   "RTN","IBC NEQU",249, 0)
  2728    ; If vali d STC ente red, set I BEISTC to  be STCIEN.
  2729   "RTN","IBC NEQU",250, 0)
  2730    S IBEISTC =$P(Y,U,1)
  2731   "RTN","IBC NEQU",251, 0)
  2732    Q
  2733   "RTN","IBC NEQU",252, 0)
  2734    ;
  2735   "RTN","IBC NEQU",253, 0)
  2736   FASTEXIT ;  Sets flag  to indica te a quick  exit from  the optio n
  2737   "RTN","IBC NEQU",254, 0)
  2738    N DIR,DIR UT,X,Y
  2739   "RTN","IBC NEQU",255, 0)
  2740    S VALMBCK ="Q"
  2741   "RTN","IBC NEQU",256, 0)
  2742    D FULL^VA LM1
  2743   "RTN","IBC NEQU",257, 0)
  2744    S DIR(0)= "Y",DIR("A ")="Exit o ption enti rely",DIR( "B")="NO"
  2745   "RTN","IBC NEQU",258, 0)
  2746    D ^DIR
  2747   "RTN","IBC NEQU",259, 0)
  2748    I +Y S IB FASTXT=1
  2749   "RTN","IBC NEQU",260, 0)
  2750    Q
  2751   "RTN","IBC NEQU",261, 0)
  2752    ;
  2753   "RTN","IBC NEQU",262, 0)
  2754   ADD() ;
  2755   "RTN","IBC NEQU",263, 0)
  2756    NEW PAYER ,TQIEN,OK, STR,SRVICE DT,FRESHDT ,DATA1,DAT A2,TQIEN,F RESHDAY
  2757   "RTN","IBC NEQU",264, 0)
  2758    I '$D(^IB CN(365.1," E",DFN)) Q  0  ; Does  this pt h ave a TQ e ntry?
  2759   "RTN","IBC NEQU",265, 0)
  2760    S (TQIEN, OK)=""
  2761   "RTN","IBC NEQU",266, 0)
  2762    S PAYER=$ $FIND1^DIC (365.12,," X","~NO PA YER") ; Ge t payer IE N
  2763   "RTN","IBC NEQU",267, 0)
  2764    F  S TQIE N=$O(^IBCN (365.1,"E" ,DFN,TQIEN )) Q:'TQIE N!OK  D
  2765   "RTN","IBC NEQU",268, 0)
  2766    . S STR=$ G(^IBCN(36 5.1,TQIEN, 0))
  2767   "RTN","IBC NEQU",269, 0)
  2768    . ; If "~ NO PAYER"  & Transmit ted
  2769   "RTN","IBC NEQU",270, 0)
  2770    . I $P(ST R,U,3)=PAY ER,$P(STR, U,4)=2 S O K=1 Q
  2771   "RTN","IBC NEQU",271, 0)
  2772    . ; If "~ NO PAYER"  & Ready to  Transmit  & override  flag
  2773   "RTN","IBC NEQU",272, 0)
  2774    . I $P(ST R,U,3)=PAY ER,($P(STR ,U,4)=1),( $P(STR,U,1 4)=1) S OK =1 Q
  2775   "RTN","IBC NEQU",273, 0)
  2776    I 'OK Q 0
  2777   "RTN","IBC NEQU",274, 0)
  2778    Q 1
  2779   "RTN","IBC NEQU",275, 0)
  2780    ;
  2781   "RTN","IBC NEQU",276, 0)
  2782   BLKTQ ;  C reate a ~N O PAYER re quest for  'Search fo r All'
  2783   "RTN","IBC NEQU",277, 0)
  2784    Q    ; no  longer al lowed  IB* 2*416
  2785   "RTN","IBC NEQU",278, 0)
  2786    NEW PAYER ,SRVICEDT, FRESHDT,DA TA1,DATA2, TQIEN,FRES HDAY
  2787   "RTN","IBC NEQU",279, 0)
  2788    S PAYER=$ $FIND1^DIC (365.12,," X","~NO PA YER")
  2789   "RTN","IBC NEQU",280, 0)
  2790    D NPINIT  ; Update s ervice dat e and fres hness
  2791   "RTN","IBC NEQU",281, 0)
  2792    ; Update  service da tes for in quiries to  be transm itted
  2793   "RTN","IBC NEQU",282, 0)
  2794    S DATA1=D FN_U_PAYER _U_1_U_""_ U_""_U_FRE SHDT
  2795   "RTN","IBC NEQU",283, 0)
  2796    S DATA2=4 _U_"I"_U_S RVICEDT
  2797   "RTN","IBC NEQU",284, 0)
  2798    S TQIEN=$ $SETTQ^IBC NEDE7(DATA 1,DATA2,"" ,1)
  2799   "RTN","IBC NEQU",285, 0)
  2800    Q
  2801   "RTN","IBC NEQU",286, 0)
  2802    ;
  2803   "RTN","IBC NEQU",287, 0)
  2804   BLKX Q
  2805   "RTN","IBC NEQU",288, 0)
  2806    ;
  2807   "RTN","IBC NEQU",289, 0)
  2808   NPINIT ; I nitialize  variables  for ~NO PA YER
  2809   "RTN","IBC NEQU",290, 0)
  2810    S SRVICED T=DT
  2811   "RTN","IBC NEQU",291, 0)
  2812    S FRESHDA Y=$P($G(^I BE(350.9,1 ,51)),U)
  2813   "RTN","IBC NEQU",292, 0)
  2814    S FRESHDT =$$FMADD^X LFDT(SRVIC EDT,-FRESH DAY)
  2815   "RTN","IBC NEQU",293, 0)
  2816    ;
  2817   "RTN","IBC NEQU",294, 0)
  2818    ; Update  service da te and fre shness dat e based on  payer all owed
  2819   "RTN","IBC NEQU",295, 0)
  2820    Q
  2821   "RTN","IBC NEQU",296, 0)
  2822    ;
  2823   "RTN","IBC NEQU",297, 0)
  2824   HELPSTC2 ;  Text to d isplay in  response t o '??' ent ry
  2825   "RTN","IBC NEQU",298, 0)
  2826    N DIR
  2827   "RTN","IBC NEQU",299, 0)
  2828    D FULL^VA LM1
  2829   "RTN","IBC NEQU",300, 0)
  2830    W @IOF
  2831   "RTN","IBC NEQU",301, 0)
  2832    W !,"Ente r the sing le SERVICE  TYPE CODE  to be sen t with inq uiry or pr ess 'ENTER ' to"
  2833   "RTN","IBC NEQU",302, 0)
  2834    W !,"send  default s ervice typ e code 30  (Health Be nefit Plan  Coverage) ."
  2835   "RTN","IBC NEQU",303, 0)
  2836    W !,"No r esponse ge nerated by  this opti on will au to-update  the patien t file."
  2837   "RTN","IBC NEQU",304, 0)
  2838    Q
  2839   "RTN","IBC NEQU",305, 0)
  2840    ;
  2841   "RTN","IBC NEQU",306, 0)
  2842   ELIGDT() ;  Prompt us er for eli gibility d ate
  2843   "RTN","IBC NEQU",307, 0)
  2844    N DIR,X,Y ,DIRUT,DUO UT,STARTDT ,ENDDT,ELI GDT
  2845   "RTN","IBC NEQU",308, 0)
  2846    S ELIGDT= ""
  2847   "RTN","IBC NEQU",309, 0)
  2848    D DT^DILF (,"T-12M", .STARTDT)  ; start da te within  the last 1 2 months
  2849   "RTN","IBC NEQU",310, 0)
  2850    ; allow e nd date up  to the en d of the c urrent mon th
  2851   "RTN","IBC NEQU",311, 0)
  2852    S ENDDT=$ $SCH^XLFDT ("1M(L@1A) ",DT)\1 ;  ICR#10103  this call  returns th e last day  of the cu rrent mont h at 1 AM.   If not t ime was se nt, it wou ld actuall y return t he next to  last day  at 2400 ho urs.
  2853   "RTN","IBC NEQU",312, 0)
  2854    S DIR(0)= "DA^"_STAR TDT_":"_EN DDT_":"_"E X",DIR("A" )="Enter E ligibility  Date: ",D IR("B")="T ODAY"
  2855   "RTN","IBC NEQU",313, 0)
  2856    S DIR("?" ,1)="Selec t an eligi bility dat e to be se nt in the  inquiry."
  2857   "RTN","IBC NEQU",314, 0)
  2858    S DIR("?" )="Date mu st be with in the las t 12 month s or up to  the end o f the curr ent month. "
  2859   "RTN","IBC NEQU",315, 0)
  2860    D ^DIR
  2861   "RTN","IBC NEQU",316, 0)
  2862    I $D(DIRU T)!$D(DUOU T)!('Y) G  ELIGDTX
  2863   "RTN","IBC NEQU",317, 0)
  2864    S ELIGDT= Y
  2865   "RTN","IBC NEQU",318, 0)
  2866   ELIGDTX ; 
  2867   "RTN","IBC NEQU",319, 0)
  2868    Q ELIGDT
  2869   "RTN","IBC NERTQ")
  2870   0^8^B46541 707^B44950 178
  2871   "RTN","IBC NERTQ",1,0 )
  2872   IBCNERTQ ; ALB/BI - R eal-time I nsurance V erificatio n ;15-OCT- 2015
  2873   "RTN","IBC NERTQ",2,0 )
  2874    ;;2.0;INT EGRATED BI LLING;**43 8,467,497, 549,582**; 21-MAR-94; Build 77
  2875   "RTN","IBC NERTQ",3,0 )
  2876    ;;Per VA  Directive  6402, this  routine s hould not  be modifie d.
  2877   "RTN","IBC NERTQ",4,0 )
  2878    Q
  2879   "RTN","IBC NERTQ",5,0 )
  2880    ;
  2881   "RTN","IBC NERTQ",6,0 )
  2882   TRIG(N2) ;  Called by  triggers  in the INS URANCE BUF FER FILE D ictionary  (355.33)
  2883   "RTN","IBC NERTQ",7,0 )
  2884    ; Fields:   20.01 -  INSURANCE  COMPANY NA ME
  2885   "RTN","IBC NERTQ",8,0 )
  2886    ;           90.01 -  GROUP NAME
  2887   "RTN","IBC NERTQ",9,0 )
  2888    ;           90.02 -  GROUP NUMB ER
  2889   "RTN","IBC NERTQ",10, 0)
  2890    ;           60.01 -  PATIENT NA ME
  2891   "RTN","IBC NERTQ",11, 0)
  2892    ;           90.03 -  SUBSCRIBER  ID
  2893   "RTN","IBC NERTQ",12, 0)
  2894    ;           60.08 -  INSURED'S  DOB
  2895   "RTN","IBC NERTQ",13, 0)
  2896    ;           62.01 -  PATIENT ID
  2897   "RTN","IBC NERTQ",14, 0)
  2898    ;
  2899   "RTN","IBC NERTQ",15, 0)
  2900    ; To make  a request  for Real  Time Verif ication
  2901   "RTN","IBC NERTQ",16, 0)
  2902    ; The fol lowing fie lds must c ontain dat a.
  2903   "RTN","IBC NERTQ",17, 0)
  2904    ;           20.01 -  INSURANCE  COMPANY NA ME
  2905   "RTN","IBC NERTQ",18, 0)
  2906    ;           60.01 -  PATIENT NA ME
  2907   "RTN","IBC NERTQ",19, 0)
  2908    ;           90.03 -  SUBSCRIBER  ID (if pa tient is t he subscri ber)
  2909   "RTN","IBC NERTQ",20, 0)
  2910    ;           60.08 -  INSURED'S  DOB (if pa tient is n ot the sub scriber)
  2911   "RTN","IBC NERTQ",21, 0)
  2912    ;           62.01 -  PATIENT ID  (if patie nt is not  the subscr iber)
  2913   "RTN","IBC NERTQ",22, 0)
  2914    ;
  2915   "RTN","IBC NERTQ",23, 0)
  2916    ;
  2917   "RTN","IBC NERTQ",24, 0)
  2918    N TQIEN,T QN0,NODE20 ,NODE60,NO DE90,QF,N4 ,PTID,SUBI D,MGRP,DFN ,PREL
  2919   "RTN","IBC NERTQ",25, 0)
  2920    N RESPONS E S RESPON SE=0
  2921   "RTN","IBC NERTQ",26, 0)
  2922    ; Protect  the FileM an variabl es.
  2923   "RTN","IBC NERTQ",27, 0)
  2924    N DA,DB,D C,DH,DI,DK ,DL,DM,DP, DQ,DR,INI, MR,NX,UP
  2925   "RTN","IBC NERTQ",28, 0)
  2926    ;
  2927   "RTN","IBC NERTQ",29, 0)
  2928    I N2="" Q  RESPONSE
  2929   "RTN","IBC NERTQ",30, 0)
  2930    ;IB*582/H AN - Do no t allow en tries to p rocess if  the user i s INTERFAC E,IB EIV
  2931   "RTN","IBC NERTQ",31, 0)
  2932    N EIVDUZ  S EIVDUZ=$ $FIND1^DIC (200,"","X ","INTERFA CE,IB EIV" )
  2933   "RTN","IBC NERTQ",32, 0)
  2934    I $G(IDUZ )'="",IDUZ =EIVDUZ Q  RESPONSE
  2935   "RTN","IBC NERTQ",33, 0)
  2936    ;IB*582 -  End
  2937   "RTN","IBC NERTQ",34, 0)
  2938    S MGRP=$$ MGRP^IBCNE UT5()
  2939   "RTN","IBC NERTQ",35, 0)
  2940    S NODE20= $G(^IBA(35 5.33,N2,20 ))
  2941   "RTN","IBC NERTQ",36, 0)
  2942    S NODE60= $G(^IBA(35 5.33,N2,60 ))
  2943   "RTN","IBC NERTQ",37, 0)
  2944    S NODE90= $G(^IBA(35 5.33,N2,90 ))
  2945   "RTN","IBC NERTQ",38, 0)
  2946    S PREL=$P (NODE60,U, 14)
  2947   "RTN","IBC NERTQ",39, 0)
  2948    I $P(NODE 20,U,1)=""  Q RESPONS E                         ;INSUR ANCE COMPA NY NAME
  2949   "RTN","IBC NERTQ",40, 0)
  2950    I $P(NODE 60,U,1)=""  Q RESPONS E                         ;PATIE NT NAME
  2951   "RTN","IBC NERTQ",41, 0)
  2952    I $P(NODE 90,U,3)=""  Q RESPONS E                         ;SUBSC RIBER ID
  2953   "RTN","IBC NERTQ",42, 0)
  2954    ; exclude  dependent  inquiries  w/o patie nt id or D OB
  2955   "RTN","IBC NERTQ",43, 0)
  2956    I PREL'=1 8,PREL'="" ,($P($G(^I BA(355.33, N2,62)),U) =""!($P(NO DE60,U,8)= "")) Q RES PONSE
  2957   "RTN","IBC NERTQ",44, 0)
  2958    ; exclude  ePharmacy  buffer en tries
  2959   "RTN","IBC NERTQ",45, 0)
  2960    I $G(IBNC PDPELIG) Q  RESPONSE   ; variabl e set in ^ IBNCPDP3
  2961   "RTN","IBC NERTQ",46, 0)
  2962    I $P($G(^ IBA(355.33 ,N2,0)),U, 17)'="" Q  RESPONSE
  2963   "RTN","IBC NERTQ",47, 0)
  2964    ;
  2965   "RTN","IBC NERTQ",48, 0)
  2966    ; prevent  HMS entri es from cr eating inq uiries
  2967   "RTN","IBC NERTQ",49, 0)
  2968    N PTR S P TR=+$P($G( ^IBA(355.3 3,N2,0)),U ,3)
  2969   "RTN","IBC NERTQ",50, 0)
  2970    I PTR,$P( $G(^IBE(35 5.12,PTR,0 )),U,2)="H MS",PREL=" " Q RESPON SE
  2971   "RTN","IBC NERTQ",51, 0)
  2972    ;
  2973   "RTN","IBC NERTQ",52, 0)
  2974    ; Quit if  a waiting  transacti on exists  in file #3 65.1
  2975   "RTN","IBC NERTQ",53, 0)
  2976    S PTID=$P (NODE60,U, 1)
  2977   "RTN","IBC NERTQ",54, 0)
  2978    S SUBID=$ P(NODE90,U ,3)
  2979   "RTN","IBC NERTQ",55, 0)
  2980    S QF=0,N4 =""
  2981   "RTN","IBC NERTQ",56, 0)
  2982    F  S N4=$ O(^IBCN(36 5.1,"E",PT ID,N4)) Q: N4=""  Q:Q F=1  D
  2983   "RTN","IBC NERTQ",57, 0)
  2984    .S TQN0=$ G(^IBCN(36 5.1,N4,0))
  2985   "RTN","IBC NERTQ",58, 0)
  2986    .; don't  send again  if there' s an entry  in the qu eue with t he same su bscriber i d, same bu ffer entry , and
  2987   "RTN","IBC NERTQ",59, 0)
  2988    .; transm ission sta tus other  than "resp onse recei ved" or "c ancelled" 
  2989   "RTN","IBC NERTQ",60, 0)
  2990    .I $P(TQN 0,U,5)=N2, ".3.7."'[( "."_$P(TQN 0,U,4)_"." ),$P(TQN0, U,16)=SUBI D S QF=1 Q
  2991   "RTN","IBC NERTQ",61, 0)
  2992    .Q
  2993   "RTN","IBC NERTQ",62, 0)
  2994    I QF=1 Q  RESPONSE                                        ; DON' T SEND AGA IN.
  2995   "RTN","IBC NERTQ",63, 0)
  2996    ;
  2997   "RTN","IBC NERTQ",64, 0)
  2998    ; Quit if  there is  a lock on  patient an d policy i n file #35 5.33
  2999   "RTN","IBC NERTQ",65, 0)
  3000    L +^IBA(3 55.33,N2): 1 I '$T Q  RESPONSE                  ; RECO RD LOCKED  By Another  Process
  3001   "RTN","IBC NERTQ",66, 0)
  3002    ;
  3003   "RTN","IBC NERTQ",67, 0)
  3004    ;Store Se rvice Type  Code in B UFFER file  #355.33 j ust before  sending t o EIV TRAN SMISSION Q UEUE
  3005   "RTN","IBC NERTQ",68, 0)
  3006    I +$G(^IB A(355.33,N 2,80))'>0  D SETSTC(N 2)
  3007   "RTN","IBC NERTQ",69, 0)
  3008    ;
  3009   "RTN","IBC NERTQ",70, 0)
  3010    ; Save an d clear th e dictiona ry 355.33  temporary  error glob al, ^TMP(" DIERR",$J)
  3011   "RTN","IBC NERTQ",71, 0)
  3012    K ^TMP("I BCNERTQ"," DIERR",$J)
  3013   "RTN","IBC NERTQ",72, 0)
  3014    M ^TMP("I BCNERTQ"," DIERR",$J) =^TMP("DIE RR",$J)
  3015   "RTN","IBC NERTQ",73, 0)
  3016    K ^TMP("D IERR",$J)
  3017   "RTN","IBC NERTQ",74, 0)
  3018    ;
  3019   "RTN","IBC NERTQ",75, 0)
  3020    ; if buff er entry i s currentl y being ed ited, set  the flag a nd quit
  3021   "RTN","IBC NERTQ",76, 0)
  3022    I $G(^TMP ("IBCNERTQ ",$J,N2,"L OCK"))=1 S  ^TMP("IBC NERTQ",$J, N2,"TRIGGE R")=1 G EN DTRIG
  3023   "RTN","IBC NERTQ",77, 0)
  3024    ;
  3025   "RTN","IBC NERTQ",78, 0)
  3026    ; Sending  to the EI V TRANSMIS ION QUEUE.
  3027   "RTN","IBC NERTQ",79, 0)
  3028    S TQIEN=$ $IBE(N2) I  'TQIEN G  ENDTRIG
  3029   "RTN","IBC NERTQ",80, 0)
  3030    ; Load an d Send HL7  Message
  3031   "RTN","IBC NERTQ",81, 0)
  3032    S RESPONS E=$$PROCSE ND(TQIEN)
  3033   "RTN","IBC NERTQ",82, 0)
  3034    ;
  3035   "RTN","IBC NERTQ",83, 0)
  3036   ENDTRIG ;  Final Clea n Up.
  3037   "RTN","IBC NERTQ",84, 0)
  3038    ;
  3039   "RTN","IBC NERTQ",85, 0)
  3040    ; Restore  the dicti onary 355. 33 tempora ry error g lobal, ^TM P("DIERR", $J)
  3041   "RTN","IBC NERTQ",86, 0)
  3042    K ^TMP("D IERR",$J)
  3043   "RTN","IBC NERTQ",87, 0)
  3044    M ^TMP("D IERR",$J)= ^TMP("IBCN ERTQ","DIE RR",$J)
  3045   "RTN","IBC NERTQ",88, 0)
  3046    K ^TMP("I BCNERTQ"," DIERR",$J)
  3047   "RTN","IBC NERTQ",89, 0)
  3048    ;
  3049   "RTN","IBC NERTQ",90, 0)
  3050    ; Remove  Dictionary  Entry Loc k.
  3051   "RTN","IBC NERTQ",91, 0)
  3052    L -^IBA(3 55.33,N2)
  3053   "RTN","IBC NERTQ",92, 0)
  3054    Q RESPONS E
  3055   "RTN","IBC NERTQ",93, 0)
  3056    ;
  3057   "RTN","IBC NERTQ",94, 0)
  3058   IBE(IEN) ;  Insurance  Buffer Ex tract
  3059   "RTN","IBC NERTQ",95, 0)
  3060    N SETSTR, FRESHDAY,I SYMBOL,STA TIEN,OVRFR ESH
  3061   "RTN","IBC NERTQ",96, 0)
  3062    N PDOD,SR VICEDT,FRE SHDT,PAYER STR,PAYERI D,SYMBOL
  3063   "RTN","IBC NERTQ",97, 0)
  3064    N PIEN,IN SNAME,MCAR EFLG,TQDT, TQIENS,TQO K,QUEUED
  3065   "RTN","IBC NERTQ",98, 0)
  3066    N TQIEN,C NT,SIDCNT, MAXCNT
  3067   "RTN","IBC NERTQ",99, 0)
  3068    ;
  3069   "RTN","IBC NERTQ",100 ,0)
  3070    S CNT=0
  3071   "RTN","IBC NERTQ",101 ,0)
  3072    ;
  3073   "RTN","IBC NERTQ",102 ,0)
  3074    S QUEUED= 0
  3075   "RTN","IBC NERTQ",103 ,0)
  3076    S SETSTR= $$SETTINGS ^IBCNEDE7( 1)     ;Re turns buff er extract  settings
  3077   "RTN","IBC NERTQ",104 ,0)
  3078    S MAXCNT= $P(SETSTR, U,4)              ;Ma x # TQ ent ries that  may be cre ated
  3079   "RTN","IBC NERTQ",105 ,0)
  3080    S:MAXCNT= "" MAXCNT= 9999999999
  3081   "RTN","IBC NERTQ",106 ,0)
  3082    ;
  3083   "RTN","IBC NERTQ",107 ,0)
  3084    S FRESHDA Y=$P($G(^I BE(350.9,1 ,51)),U,1)            ;System fr eshness da ys
  3085   "RTN","IBC NERTQ",108 ,0)
  3086    ;
  3087   "RTN","IBC NERTQ",109 ,0)
  3088    ; Get sym bol, if sy mbol'=" "  OR "!" OR  "#" then q uit
  3089   "RTN","IBC NERTQ",110 ,0)
  3090    S ISYMBOL =$$SYMBOL^ IBCNBLL(IE N)                    ;Insurance  buffer sy mbol
  3091   "RTN","IBC NERTQ",111 ,0)
  3092    I (ISYMBO L'=" ")&(I SYMBOL'="! ")&(ISYMBO L'="#") Q  QUEUED
  3093   "RTN","IBC NERTQ",112 ,0)
  3094    ;
  3095   "RTN","IBC NERTQ",113 ,0)
  3096    ; IB*2.0* 549 -  Qui t if Realt ime  Extra ct Master  switch is  off
  3097   "RTN","IBC NERTQ",114 ,0)
  3098    ; Note: C hecking he re instead  of the to p of TRIG  to check f or above e rror condi tions firs t
  3099   "RTN","IBC NERTQ",115 ,0)
  3100    Q:$$GET1^ DIQ(350.9, "1,",51.27 ,"I")="N"  0
  3101   "RTN","IBC NERTQ",116 ,0)
  3102    ;
  3103   "RTN","IBC NERTQ",117 ,0)
  3104    ; Get the  eIV STATU S IEN and  quit for r esponse re lated erro rs
  3105   "RTN","IBC NERTQ",118 ,0)
  3106    S STATIEN =+$P($G(^I BA(355.33, IEN,0)),U, 12)
  3107   "RTN","IBC NERTQ",119 ,0)
  3108    I ",11,12 ,15,"[("," _STATIEN_" ,") Q QUEU ED         ;Prevent u pdate for  response e rrors
  3109   "RTN","IBC NERTQ",120 ,0)
  3110    ;
  3111   "RTN","IBC NERTQ",121 ,0)
  3112    S OVRFRES H=$P($G(^I BA(355.33, IEN,0)),U, 13)        ;Freshness  OvrRd fla g
  3113   "RTN","IBC NERTQ",122 ,0)
  3114    S DFN=$P( $G(^IBA(35 5.33,IEN,6 0)),U,1)              ;Patient D FN
  3115   "RTN","IBC NERTQ",123 ,0)
  3116    Q:DFN=""  QUEUED
  3117   "RTN","IBC NERTQ",124 ,0)
  3118    I $P($G(^ DPT(DFN,0) ),U,21) Q  QUEUED                ;Exclude i f test pat ient
  3119   "RTN","IBC NERTQ",125 ,0)
  3120    ;
  3121   "RTN","IBC NERTQ",126 ,0)
  3122    S PDOD=$P ($G(^DPT(D FN,.35)),U ,1)\1                 ;Patient's  date of d eath
  3123   "RTN","IBC NERTQ",127 ,0)
  3124    S SRVICED T=+$P($G(^ IBA(355.33 ,IEN,0)),U ,18) S:'SR VICEDT SRV ICEDT=DT ;  Service D ate
  3125   "RTN","IBC NERTQ",128 ,0)
  3126    ;
  3127   "RTN","IBC NERTQ",129 ,0)
  3128    ; IB*2.0* 549 Remove d followin g line
  3129   "RTN","IBC NERTQ",130 ,0)
  3130    ;I PDOD,P DOD<SRVICE DT S SRVIC EDT=PDOD
  3131   "RTN","IBC NERTQ",131 ,0)
  3132    S FRESHDT =$$FMADD^X LFDT(SRVIC EDT,-FRESH DAY)
  3133   "RTN","IBC NERTQ",132 ,0)
  3134    S PAYERST R=$$INSERR OR^IBCNEUT 3("B",IEN)            ;Payer Str ing
  3135   "RTN","IBC NERTQ",133 ,0)
  3136    S PAYERID =$P(PAYERS TR,U,3),PI EN=$P(PAYE RSTR,U,2)  ;Payer ID
  3137   "RTN","IBC NERTQ",134 ,0)
  3138    S SYMBOL= +PAYERSTR                                   ;Payer Sym bol
  3139   "RTN","IBC NERTQ",135 ,0)
  3140    I '$$PYRA CTV^IBCNED E7(PIEN) Q  QUEUED               ;Payer is  not nation ally activ e
  3141   "RTN","IBC NERTQ",136 ,0)
  3142    ;
  3143   "RTN","IBC NERTQ",137 ,0)
  3144    ; If paye r symbol i s returned  set symbo l in Ins.  Buffer and  quit
  3145   "RTN","IBC NERTQ",138 ,0)
  3146    I SYMBOL  D BUFF^IBC NEUT2(IEN, SYMBOL) Q  QUEUED
  3147   "RTN","IBC NERTQ",139 ,0)
  3148    ;
  3149   "RTN","IBC NERTQ",140 ,0)
  3150    D CLEAR^I BCNEUT4(IE N)                               ;Remove an y existing  symbol
  3151   "RTN","IBC NERTQ",141 ,0)
  3152    ;
  3153   "RTN","IBC NERTQ",142 ,0)
  3154    ; If no p ayer ID or  no payer  IEN is ret urned quit
  3155   "RTN","IBC NERTQ",143 ,0)
  3156    I (PAYERI D="")!('PI EN) Q QUEU ED
  3157   "RTN","IBC NERTQ",144 ,0)
  3158    ;
  3159   "RTN","IBC NERTQ",145 ,0)
  3160    ; Update  service da te and fre shness dat e based on  payer's a llowed
  3161   "RTN","IBC NERTQ",146 ,0)
  3162    ;  date r ange
  3163   "RTN","IBC NERTQ",147 ,0)
  3164    D UPDDTS^ IBCNEDE6(P IEN,.SRVIC EDT,.FRESH DT)
  3165   "RTN","IBC NERTQ",148 ,0)
  3166    ;
  3167   "RTN","IBC NERTQ",149 ,0)
  3168    ; Update  service da tes for in quiries to  be transm itted
  3169   "RTN","IBC NERTQ",150 ,0)
  3170    D TQUPDSV ^IBCNEUT5( DFN,PIEN,S RVICEDT)
  3171   "RTN","IBC NERTQ",151 ,0)
  3172    ;
  3173   "RTN","IBC NERTQ",152 ,0)
  3174    ; Allow o nly one ME DICARE tra nsmission  per patien t
  3175   "RTN","IBC NERTQ",153 ,0)
  3176    S INSNAME =$P($G(^IB A(355.33,I EN,20)),U)
  3177   "RTN","IBC NERTQ",154 ,0)
  3178    I INSNAME ["MEDICARE ",$G(MCARE FLG(DFN))  Q QUEUED
  3179   "RTN","IBC NERTQ",155 ,0)
  3180    ; make su re that en tries have  pat. rela tionship s et to "sel f"
  3181   "RTN","IBC NERTQ",156 ,0)
  3182    D SETREL^ IBCNEDE1(I EN)
  3183   "RTN","IBC NERTQ",157 ,0)
  3184    ;
  3185   "RTN","IBC NERTQ",158 ,0)
  3186    ; If fres hness over ride flag  is set, fi le to TQ a nd quit
  3187   "RTN","IBC NERTQ",159 ,0)
  3188    I OVRFRES H=1 D  Q $ G(TQIEN)
  3189   "RTN","IBC NERTQ",160 ,0)
  3190    . NEW DIE ,X,Y,DISYS
  3191   "RTN","IBC NERTQ",161 ,0)
  3192    . S FDA(3 55.33,IEN_ ",",.13)=" " D FILE^D IE("","FDA ") K FDA
  3193   "RTN","IBC NERTQ",162 ,0)
  3194    . S:INSNA ME["MEDICA RE" MCAREF LG(DFN)=1  D TQ^IBCNE DE1
  3195   "RTN","IBC NERTQ",163 ,0)
  3196    ; Check t he existin g TQ entri es to conf irm that t his buffer  IEN is
  3197   "RTN","IBC NERTQ",164 ,0)
  3198    ; not inc luded
  3199   "RTN","IBC NERTQ",165 ,0)
  3200    S (TQDT,T QIENS)="", TQOK=1
  3201   "RTN","IBC NERTQ",166 ,0)
  3202    I ISYMBOL '="#" F  S  TQDT=$O(^ IBCN(365.1 ,"AD",DFN, PIEN,TQDT) ) Q:'TQDT! 'TQOK  D
  3203   "RTN","IBC NERTQ",167 ,0)
  3204    . F  S TQ IENS=$O(^I BCN(365.1, "AD",DFN,P IEN,TQDT,T QIENS)) Q: 'TQIENS!'T QOK  D
  3205   "RTN","IBC NERTQ",168 ,0)
  3206    .. I $P($ G(^IBCN(36 5.1,TQIENS ,0)),U,5)= IEN S TQOK =0 Q
  3207   "RTN","IBC NERTQ",169 ,0)
  3208    I TQOK S: INSNAME["M EDICARE" M CAREFLG(DF N)=1 D TQ^ IBCNEDE1
  3209   "RTN","IBC NERTQ",170 ,0)
  3210    Q $G(TQIE N)
  3211   "RTN","IBC NERTQ",171 ,0)
  3212    ;
  3213   "RTN","IBC NERTQ",172 ,0)
  3214   PROCSEND(T QIEN) ; Ma ke call to  PROC^IBCN EDEP to bu ild the HL 7 message.   Then sen d the Mess age.
  3215   "RTN","IBC NERTQ",173 ,0)
  3216    N BUFF,CN T,D,D0,DFN ,DIC,DIE,D ILOCKTM,DI SYS,EXT
  3217   "RTN","IBC NERTQ",174 ,0)
  3218    N FRDT,GT 1,HCT,HL,H LCDOM,HLCI NS,HLCS,HL CSTCP,HLDO M,HLECH
  3219   "RTN","IBC NERTQ",175 ,0)
  3220    N HLFS,HL HDR,HLINST ,HLIP,HLN, HLP,HLPARA M,HLPROD,H LQ,HLRESLT
  3221   "RTN","IBC NERTQ",176 ,0)
  3222    N HLSAN,H LTYPE,HLX, IBCNHLP,IE N,IHCNT,IN 1,IRIEN,MS GID,TOT
  3223   "RTN","IBC NERTQ",177 ,0)
  3224    N NRETR,N TRAN,OVRID E,PATID,PA YR,PID,QUE RY,RSTYPE, SRVDT,STA
  3225   "RTN","IBC NERTQ",178 ,0)
  3226    N SUB4,SU BID,TRANSR ,U,VACNTRY ,VNUM,X,ZM ID
  3227   "RTN","IBC NERTQ",179 ,0)
  3228    ;
  3229   "RTN","IBC NERTQ",180 ,0)
  3230    K ^TMP("H LS",$J)
  3231   "RTN","IBC NERTQ",181 ,0)
  3232    S IEN=TQI EN
  3233   "RTN","IBC NERTQ",182 ,0)
  3234    I $D(DT)= 0 N DT S D T=$$DT^XLF DT
  3235   "RTN","IBC NERTQ",183 ,0)
  3236    S U="^",C NT=0,TOT=0 ,IHCNT=0
  3237   "RTN","IBC NERTQ",184 ,0)
  3238    S QUERY=$ P($G(^IBCN (365.1,IEN ,0)),U,11)
  3239   "RTN","IBC NERTQ",185 ,0)
  3240    I QUERY=" V" S VNUM= 3
  3241   "RTN","IBC NERTQ",186 ,0)
  3242    I $D(VNUM )=0 Q 0
  3243   "RTN","IBC NERTQ",187 ,0)
  3244    ;
  3245   "RTN","IBC NERTQ",188 ,0)
  3246    ; IB*2.0* 549 - quit  if test s ite and no t a valid  test case
  3247   "RTN","IBC NERTQ",189 ,0)
  3248    Q:'$$XMIT OK^IBCNEUT 7(IEN) 0
  3249   "RTN","IBC NERTQ",190 ,0)
  3250    ;
  3251   "RTN","IBC NERTQ",191 ,0)
  3252    ;  Initia lize HL7 v ariables p rotocol fo r Verifica tions
  3253   "RTN","IBC NERTQ",192 ,0)
  3254    S IBCNHLP ="IBCNE II V RQV OUT"
  3255   "RTN","IBC NERTQ",193 ,0)
  3256    D INIT^IB CNEHLO
  3257   "RTN","IBC NERTQ",194 ,0)
  3258    D PROC^IB CNEDEP
  3259   "RTN","IBC NERTQ",195 ,0)
  3260    D GENERAT E^HLMA(IBC NHLP,"GM", 1,.HLRESLT ,"",.HLP)
  3261   "RTN","IBC NERTQ",196 ,0)
  3262    ;  If not  successfu l
  3263   "RTN","IBC NERTQ",197 ,0)
  3264    I $P(HLRE SLT,U,2)]" " D HLER^I BCNEDEQ Q  0
  3265   "RTN","IBC NERTQ",198 ,0)
  3266    ;  If suc cessful
  3267   "RTN","IBC NERTQ",199 ,0)
  3268    D SCC^IBC NEDEQ
  3269   "RTN","IBC NERTQ",200 ,0)
  3270    K ^TMP("H LS",$J)
  3271   "RTN","IBC NERTQ",201 ,0)
  3272    ;
  3273   "RTN","IBC NERTQ",202 ,0)
  3274    I $G(^TMP ("IBCNEQUD TS",$J)) D
  3275   "RTN","IBC NERTQ",203 ,0)
  3276    . S DA=IE N,DIE="^IB CN(365.1," ,DR="3.01/ ///^S X=$$ NOW^XLFDT"  D ^DIE
  3277   "RTN","IBC NERTQ",204 ,0)
  3278    ;
  3279   "RTN","IBC NERTQ",205 ,0)
  3280    Q 1
  3281   "RTN","IBC NERTQ",206 ,0)
  3282    ;
  3283   "RTN","IBC NERTQ",207 ,0)
  3284   SETSTC(BUF F) ; set s ervice typ e code
  3285   "RTN","IBC NERTQ",208 ,0)
  3286    N DIE,DA, DR,X,Y
  3287   "RTN","IBC NERTQ",209 ,0)
  3288    I '+$G(BU FF) Q
  3289   "RTN","IBC NERTQ",210 ,0)
  3290    ; Define  Service Ty pe Code (S TC) to be  sent with  Insurance  Inquiry
  3291   "RTN","IBC NERTQ",211 ,0)
  3292    S DIE="^I BA(355.33, ",DA=BUFF
  3293   "RTN","IBC NERTQ",212 ,0)
  3294    S DR="80. 01////"_$P ($G(^IBE(3 50.9,1,60) ),U)
  3295   "RTN","IBC NERTQ",213 ,0)
  3296    D ^DIE
  3297   "RTN","IBC NERTQ",214 ,0)
  3298    Q
  3299   "RTN","IBC NEUT7")
  3300   0^2^B82015 033^B79064 178
  3301   "RTN","IBC NEUT7",1,0 )
  3302   IBCNEUT7 ; DAOU/ALA -  IIV MISC.  UTILITIES  ;14-OCT-2 015
  3303   "RTN","IBC NEUT7",2,0 )
  3304    ;;2.0;INT EGRATED BI LLING;**18 4,549,579, 582**;21-M AR-94;Buil d 77
  3305   "RTN","IBC NEUT7",3,0 )
  3306    ;;Per VA  Directive  6402, this  routine s hould not  be modifie d.
  3307   "RTN","IBC NEUT7",4,0 )
  3308    ;
  3309   "RTN","IBC NEUT7",5,0 )
  3310    ;**Progra m Descript ion**
  3311   "RTN","IBC NEUT7",6,0 )
  3312    ;  This p rogram con tains some  general u tilities o r function s
  3313   "RTN","IBC NEUT7",7,0 )
  3314    ;
  3315   "RTN","IBC NEUT7",8,0 )
  3316    Q
  3317   "RTN","IBC NEUT7",9,0 )
  3318    ;
  3319   "RTN","IBC NEUT7",10, 0)
  3320   DEATH(DFN, DOD)   ;EP
  3321   "RTN","IBC NEUT7",11, 0)
  3322    ; IB*2.0* 549 added  method
  3323   "RTN","IBC NEUT7",12, 0)
  3324    ; Sets th e INSURANC E EXPIRATI ON DATE (f ile 2.3121 , field )  for all ac tive
  3325   "RTN","IBC NEUT7",13, 0)
  3326    ; insuran ces of the  selected  patient to  be the da te of deat h +1
  3327   "RTN","IBC NEUT7",14, 0)
  3328    ; Input:    DFN      - IEN of t he patient  to term i nsurances  for
  3329   "RTN","IBC NEUT7",15, 0)
  3330    ;           DOD      - Internal  date of d eath (file  2, field  .351) of t he patient
  3331   "RTN","IBC NEUT7",16, 0)
  3332    N MTIME,Z TRTN,ZTDES C,ZTDTH,ZT IO,ZTUCI,Z TCPU,ZTPRI ,ZTSAVE,ZT KIL,ZTSYNC ,ZTSK
  3333   "RTN","IBC NEUT7",17, 0)
  3334    S MTIME=$ $NOW^XLFDT ()                        ; File man date/t ime
  3335   "RTN","IBC NEUT7",18, 0)
  3336    S ZTDTH=$ $FMTH^XLFD T(MTIME)                  ; Conv ert to $H  format
  3337   "RTN","IBC NEUT7",19, 0)
  3338    ;
  3339   "RTN","IBC NEUT7",20, 0)
  3340    ; Set up  the other  TaskManage r variable s
  3341   "RTN","IBC NEUT7",21, 0)
  3342    S ZTRTN=" DEATH2^IBC NEUT7"
  3343   "RTN","IBC NEUT7",22, 0)
  3344    S ZTDESC= "eIV Auto  Terminatio n of Polic ies for de ceased pat ients"
  3345   "RTN","IBC NEUT7",23, 0)
  3346    S ZTIO=""
  3347   "RTN","IBC NEUT7",24, 0)
  3348    S ZTSAVE( "DFN")="", ZTSAVE("DO D")=""
  3349   "RTN","IBC NEUT7",25, 0)
  3350    D ^%ZTLOA D ; Call T askManager
  3351   "RTN","IBC NEUT7",26, 0)
  3352    Q
  3353   "RTN","IBC NEUT7",27, 0)
  3354    ;
  3355   "RTN","IBC NEUT7",28, 0)
  3356   DEATH2 ;EP  from Task Man
  3357   "RTN","IBC NEUT7",29, 0)
  3358    ; IB*2.0* 549 added  method
  3359   "RTN","IBC NEUT7",30, 0)
  3360    ; Sets th e INSURANC E EXPIRATI ON DATE (f ile 2.3121 , field )  for all ac tive
  3361   "RTN","IBC NEUT7",31, 0)
  3362    ; insuran ces of the  selected  patient to  be the da te of deat h +1
  3363   "RTN","IBC NEUT7",32, 0)
  3364    ; IB*2.0* 579 - Also  sets the  'COVERED B Y HEALTH I NSURANCE'  to 'N' (fi le 2, fiel d .3192)
  3365   "RTN","IBC NEUT7",33, 0)
  3366    ;               if i t's not al ready set  to 'N'
  3367   "RTN","IBC NEUT7",34, 0)
  3368    ; Input:    DFN      - IEN of t he patient  to term i nsurances  for
  3369   "RTN","IBC NEUT7",35, 0)
  3370    ;           DOD      - Internal  date of d eath (file  2, field  .351) of t he patient
  3371   "RTN","IBC NEUT7",36, 0)
  3372    N EXPDT,D A,DEACT,DO DX,FDA,HCO V,IBIEN                  ; IB*2. 0*579 - ad ded DEACT, HCOV
  3373   "RTN","IBC NEUT7",37, 0)
  3374    S DEACT=0                                                ; IB*2. 0*579 - ad ded line
  3375   "RTN","IBC NEUT7",38, 0)
  3376    S DODX=$P ($$FMADD^X LFDT(DOD,1 ),".",1)                 ; Date  of Death + 1
  3377   "RTN","IBC NEUT7",39, 0)
  3378    S IBIEN=0
  3379   "RTN","IBC NEUT7",40, 0)
  3380    F  S IBIE N=$O(^DPT( DFN,.312,I BIEN)) Q:+ IBIEN=0  D
  3381   "RTN","IBC NEUT7",41, 0)
  3382    . S EXPDT =$$GET1^DI Q(2.312,IB IEN_","_DF N_",",3,"I ") ; Polic y Expirati on Date
  3383   "RTN","IBC NEUT7",42, 0)
  3384    . Q:EXPDT '=""                                           ; Polic y has an e xpiration  date
  3385   "RTN","IBC NEUT7",43, 0)
  3386    . L +^DPT (DFN,.312, IBIEN):5
  3387   "RTN","IBC NEUT7",44, 0)
  3388    . I '$T D   Q                                            ; Send  email IB S UPERVISOR  users
  3389   "RTN","IBC NEUT7",45, 0)
  3390    . . N EDT ,MLGRP,MSG ,PNM,SSN,S UBJECT,XMY
  3391   "RTN","IBC NEUT7",46, 0)
  3392    . . S SUB JECT="eIV:  Policy Ex piration f or decease d patient"
  3393   "RTN","IBC NEUT7",47, 0)
  3394    . . S MLG RP=$$MGRP^ IBCNEUT5
  3395   "RTN","IBC NEUT7",48, 0)
  3396    . . S PNM =$$GET1^DI Q(2,DFN,.0 1)
  3397   "RTN","IBC NEUT7",49, 0)
  3398    . . S EDT =$$FMTE^XL FDT(DODX," 2DZ")
  3399   "RTN","IBC NEUT7",50, 0)
  3400    . . S SSN =$$GET1^DI Q(2,DFN,.0 9),SSN=$E( SSN,6,9)
  3401   "RTN","IBC NEUT7",51, 0)
  3402    . . S MSG (1)=PNM_"  "_SSN_" wa s just mar ked as dec eased. Act ion Needed :"
  3403   "RTN","IBC NEUT7",52, 0)
  3404    . . S MSG (2)=" Upda te the pat ient's act ive polici es and ent er and exp iration da te of "_ED T_"."
  3405   "RTN","IBC NEUT7",53, 0)
  3406    . . D GET PER("IB SU PERVISOR", .XMY)
  3407   "RTN","IBC NEUT7",54, 0)
  3408    . . D MSG ^IBCNEUT5( MLGRP,SUBJ ECT,"MSG(" ,,.XMY)
  3409   "RTN","IBC NEUT7",55, 0)
  3410    . ;
  3411   "RTN","IBC NEUT7",56, 0)
  3412    . ; Set P olicy expi ration dat e to be da te of deat h +1
  3413   "RTN","IBC NEUT7",57, 0)
  3414    . S DEACT =1                                            ; IB*2.0 *579 - add ed line
  3415   "RTN","IBC NEUT7",58, 0)
  3416    . K DA,FD A
  3417   "RTN","IBC NEUT7",59, 0)
  3418    . S DA=IB IEN,DA(1)= DFN
  3419   "RTN","IBC NEUT7",60, 0)
  3420    . S FDA(2 .312,DA_", "_DA(1)_", ",1.05)=$$ NOW^XLFDT( ) ; Date L ast Edited
  3421   "RTN","IBC NEUT7",61, 0)
  3422    . S FDA(2 .312,DA_", "_DA(1)_", ",1.06)=.5              ; Last E dited By
  3423   "RTN","IBC NEUT7",62, 0)
  3424    . S FDA(2 .312,DA_", "_DA(1)_", ",3)=DODX               ; Date o f Death +1
  3425   "RTN","IBC NEUT7",63, 0)
  3426    . D FILE^ DIE("","FD A")
  3427   "RTN","IBC NEUT7",64, 0)
  3428    . L -^DPT (DFN,.312, IBIEN)
  3429   "RTN","IBC NEUT7",65, 0)
  3430    ;
  3431   "RTN","IBC NEUT7",66, 0)
  3432    ; IB*2.0* 579 - adde d if state ment below
  3433   "RTN","IBC NEUT7",67, 0)
  3434    ; If any  policies w ere expire d and the  Covered by  Health In surance fl ag is set  to 'Y'.
  3435   "RTN","IBC NEUT7",68, 0)
  3436    ; change  it to 'N'
  3437   "RTN","IBC NEUT7",69, 0)
  3438    I DEACT D
  3439   "RTN","IBC NEUT7",70, 0)
  3440    . S HCOV= $$GET1^DIQ (2,DFN_"," ,.3192,"I" )
  3441   "RTN","IBC NEUT7",71, 0)
  3442    . Q:HCOV' ="Y"                                 ; Alre ady set to  'N'
  3443   "RTN","IBC NEUT7",72, 0)
  3444    . N IBSUP RES
  3445   "RTN","IBC NEUT7",73, 0)
  3446    . S IBSUP RES=1
  3447   "RTN","IBC NEUT7",74, 0)
  3448    . D COVER ED^IBCNSM3 1(DFN,HCOV )              ; Set  the Health  Coverage  flag to 'N '
  3449   "RTN","IBC NEUT7",75, 0)
  3450    Q
  3451   "RTN","IBC NEUT7",76, 0)
  3452    ;
  3453   "RTN","IBC NEUT7",77, 0)
  3454   GETPER(SEC KEY,XMY) ; EP
  3455   "RTN","IBC NEUT7",78, 0)
  3456    ; IB*2.0* 549 Added  method
  3457   "RTN","IBC NEUT7",79, 0)
  3458    ; Returns  a list of  users wit h the spec ified secu rity key
  3459   "RTN","IBC NEUT7",80, 0)
  3460    ; Input:  SECKEY - S ecurity ke y to searc h for
  3461   "RTN","IBC NEUT7",81, 0)
  3462    ; Output:  XMY() - A rray email  addresses  for users  who have  the specif ied key
  3463   "RTN","IBC NEUT7",82, 0)
  3464    N XUSIEN, X
  3465   "RTN","IBC NEUT7",83, 0)
  3466    S XUSIEN= 0
  3467   "RTN","IBC NEUT7",84, 0)
  3468    F  S XUSI EN=$O(^XUS EC(SECKEY, XUSIEN)) Q :'XUSIEN   D
  3469   "RTN","IBC NEUT7",85, 0)
  3470    . ;
  3471   "RTN","IBC NEUT7",86, 0)
  3472    . ; Don't  return TE RMINATED o r DISUSERe d users
  3473   "RTN","IBC NEUT7",87, 0)
  3474    . S X=$$A CTIVE^XUSE R(XUSIEN)
  3475   "RTN","IBC NEUT7",88, 0)
  3476    . I X=""! ($P(X,"^", 1)=0) Q
  3477   "RTN","IBC NEUT7",89, 0)
  3478    . ;
  3479   "RTN","IBC NEUT7",90, 0)
  3480    . ; Put u sers email s into out put array
  3481   "RTN","IBC NEUT7",91, 0)
  3482    . S XMY(X USIEN)=""
  3483   "RTN","IBC NEUT7",92, 0)
  3484    Q
  3485   "RTN","IBC NEUT7",93, 0)
  3486    ;
  3487   "RTN","IBC NEUT7",94, 0)
  3488   FTFIC(IBIE N,MDCALL)  ;EP
  3489   "RTN","IBC NEUT7",95, 0)
  3490    ; IB*2.0* 549 added  function
  3491   "RTN","IBC NEUT7",96, 0)
  3492    ; Returns  Timely Fi ling Timef rame text  for a spec ified Insu rance Comp any
  3493   "RTN","IBC NEUT7",97, 0)
  3494    ; transla te fields  36,.18 and  36,.19 to  agreed up on display ed text fo r
  3495   "RTN","IBC NEUT7",98, 0)
  3496    ; Insuran ce company  Reports
  3497   "RTN","IBC NEUT7",99, 0)
  3498    ; Input:    IBIEN    - IEN of t he insuran ce company  to get da ta from
  3499   "RTN","IBC NEUT7",100 ,0)
  3500    ;           MDCALL -  1 if bein g called f rom the Mi ssing Data  Report
  3501   "RTN","IBC NEUT7",101 ,0)
  3502    ;                     0 otherwi se. Option al, defaul ts to 0
  3503   "RTN","IBC NEUT7",102 ,0)
  3504    ; Returns : Timely F iling Time frame text  for the s pecified I nsurance C ompany
  3505   "RTN","IBC NEUT7",103 ,0)
  3506    ;           NOTE: If  MDCALL=1  null Stand ard FTF Va lues and Q ualifiers  are 
  3507   "RTN","IBC NEUT7",104 ,0)
  3508    ;                 as  '###' ins tead of nu ll or 'UNK NOWN' resp ectively
  3509   "RTN","IBC NEUT7",105 ,0)
  3510    N FTF,FTF V
  3511   "RTN","IBC NEUT7",106 ,0)
  3512    S:'$D(MDC ALL) MDCAL L=0
  3513   "RTN","IBC NEUT7",107 ,0)
  3514    Q:'$D(IBI EN) ""
  3515   "RTN","IBC NEUT7",108 ,0)
  3516    S FTF=$$G ET1^DIQ(36 ,IBIEN_"," ,.18,"I")      ; Stan dard FTF I EN (file 3 55.13)
  3517   "RTN","IBC NEUT7",109 ,0)
  3518    S FTFV=$$ GET1^DIQ(3 6,IBIEN_", ",.19,"I")     ; Stan dard FTF V alue
  3519   "RTN","IBC NEUT7",110 ,0)
  3520    Q $$FTFMA P(FTF,FTFV ,MDCALL)
  3521   "RTN","IBC NEUT7",111 ,0)
  3522    ;
  3523   "RTN","IBC NEUT7",112 ,0)
  3524   FTFGP(GIEN ,MDCALL) ; EP
  3525   "RTN","IBC NEUT7",113 ,0)
  3526    ; IB*2.0* 549 added  function
  3527   "RTN","IBC NEUT7",114 ,0)
  3528    ; Returns  Timely Fi ling Timef rame text  for a spec ified Grou p Insuranc e Plan
  3529   "RTN","IBC NEUT7",115 ,0)
  3530    ; transla te fields  355.3,.16  and 355.3, .17 to agr eed upon d isplayed t ext for
  3531   "RTN","IBC NEUT7",116 ,0)
  3532    ; Insuran ce company  Reports
  3533   "RTN","IBC NEUT7",117 ,0)
  3534    ; Input:    GIEN   -  IEN of th e group in surance pl an to get  data from
  3535   "RTN","IBC NEUT7",118 ,0)
  3536    ;           MDCALL -  1 if bein g called f rom the Mi ssing Data  Report
  3537   "RTN","IBC NEUT7",119 ,0)
  3538    ;                     0 otherwi se. Option al, defaul ts to 0
  3539   "RTN","IBC NEUT7",120 ,0)
  3540    ; Returns : Timely F iling Time frame text  for the s pecified G roup Insur ance Plan
  3541   "RTN","IBC NEUT7",121 ,0)
  3542    ;           NOTE: If  MDCALL=1  null Stand ard FTF Va lues and Q ualifiers  are 
  3543   "RTN","IBC NEUT7",122 ,0)
  3544    ;                 as  '###' ins tead of nu ll or 'UNK NOWN' resp ectively
  3545   "RTN","IBC NEUT7",123 ,0)
  3546    N FTF,FTF V,XX,ZZ
  3547   "RTN","IBC NEUT7",124 ,0)
  3548    S:'$D(MDC ALL) MDCAL L=0
  3549   "RTN","IBC NEUT7",125 ,0)
  3550    Q:'$D(GIE N) ""
  3551   "RTN","IBC NEUT7",126 ,0)
  3552    S FTF=$$G ET1^DIQ(35 5.3,GIEN_" ,",.16,"I" )   ; Stan dard FTF I EN (file 3 55.13)
  3553   "RTN","IBC NEUT7",127 ,0)
  3554    S FTFV=$$ GET1^DIQ(3 55.3,GIEN_ ",",.17,"I ")  ; Stan dard FTF V alue
  3555   "RTN","IBC NEUT7",128 ,0)
  3556    Q $$FTFMA P(FTF,FTFV ,MDCALL)
  3557   "RTN","IBC NEUT7",129 ,0)
  3558    ;
  3559   "RTN","IBC NEUT7",130 ,0)
  3560   FTFMAP(FIE N,FTFV,MDC ALL) ; Ret urns Timel y Filing T ext for th e specifie d Standard  FTF
  3561   "RTN","IBC NEUT7",131 ,0)
  3562    ; and Sta ndard FTF  Value
  3563   "RTN","IBC NEUT7",132 ,0)
  3564    ;IB*2.0*5 49 added f unction
  3565   "RTN","IBC NEUT7",133 ,0)
  3566    ; Input:    FIEN   -  IEN of th e Standard  FTF (file r 355.13)
  3567   "RTN","IBC NEUT7",134 ,0)
  3568    ;           MDCALL -  1 if bein g called f rom the Mi ssing Data  Report
  3569   "RTN","IBC NEUT7",135 ,0)
  3570    ;                     0 otherwi se. Option al, defaul ts to 0
  3571   "RTN","IBC NEUT7",136 ,0)
  3572    ; Output:   FTFV     - Standard  FTF Value
  3573   "RTN","IBC NEUT7",137 ,0)
  3574    ; Returns : Timely F iling Time frame text
  3575   "RTN","IBC NEUT7",138 ,0)
  3576    N FTF
  3577   "RTN","IBC NEUT7",139 ,0)
  3578    S:'$D(MDC ALL) MDCAL L=0
  3579   "RTN","IBC NEUT7",140 ,0)
  3580    I MDCALL, FTFV="" S  FTFV="###"
  3581   "RTN","IBC NEUT7",141 ,0)
  3582    S FTF=$$G ET1^DIQ(35 5.13,FIEN_ ",",.01)        ; Sta ndard FTF  name
  3583   "RTN","IBC NEUT7",142 ,0)
  3584    Q:FTF=""  FTFV_" ("_ $S(MDCALL: "###",1:"U NKNOWN")_" )"
  3585   "RTN","IBC NEUT7",143 ,0)
  3586    Q:FTF="DA YS" FTFV_"  (DYS)"
  3587   "RTN","IBC NEUT7",144 ,0)
  3588    Q:FTF="DA YS OF FOLL OWING YEAR " FTFV_" ( DYS OF NEX T YR)"
  3589   "RTN","IBC NEUT7",145 ,0)
  3590    Q:FTF="DA YS PLUS ON E YEAR" FT FV_" (DYS_ 1 YR)"
  3591   "RTN","IBC NEUT7",146 ,0)
  3592    Q:FTF="EN D OF FOLLO WING YEAR"  FTFV_" (E ND OF NEXT  YR)"
  3593   "RTN","IBC NEUT7",147 ,0)
  3594    Q:FTF="MO NTH(S)" FT FV_" (MOS) "
  3595   "RTN","IBC NEUT7",148 ,0)
  3596    Q:FTF="MO NTHS OF FO LLOWING YE AR" FTFV_"  (MOS OF N EXT YR)"
  3597   "RTN","IBC NEUT7",149 ,0)
  3598    Q:FTF="NO  FILING TI ME FRAME L IMIT" FTFV _" (N/A)"
  3599   "RTN","IBC NEUT7",150 ,0)
  3600    Q:FTF="YE AR(S)" FTF V_" (YRS)"
  3601   "RTN","IBC NEUT7",151 ,0)
  3602    Q FTFV_"  ("_$S(MDCA LL:"###",1 :"UNKNOWN" )_")"
  3603   "RTN","IBC NEUT7",152 ,0)
  3604    ;
  3605   "RTN","IBC NEUT7",153 ,0)
  3606   XMITOK(TQI EN) ;EP
  3607   "RTN","IBC NEUT7",154 ,0)
  3608    ; IB*2.0* 549 added  function
  3609   "RTN","IBC NEUT7",155 ,0)
  3610    ; Checks  if the sit e is a tes t site (no t a produc tion site)  and if so
  3611   "RTN","IBC NEUT7",156 ,0)
  3612    ; only al lows trans actions in  the eIV q ueue that  meet speci fic criter ia
  3613   "RTN","IBC NEUT7",157 ,0)
  3614    ; to be t ransmitted  to FSC. P revents in valid tran smissions  from a tes t
  3615   "RTN","IBC NEUT7",158 ,0)
  3616    ; site to  FSC which  blocks th e interfac e and need  to be man ually reso lved
  3617   "RTN","IBC NEUT7",159 ,0)
  3618    ; at FSC.
  3619   "RTN","IBC NEUT7",160 ,0)
  3620    ; Input:    TQIEN    - IEN of t he IIV Tra nsmission  Queue entr y
  3621   "RTN","IBC NEUT7",161 ,0)
  3622    ; Returns : 1        - Ok to ad d item to  the eIV qu eue
  3623   "RTN","IBC NEUT7",162 ,0)
  3624    ;           0        - Not ok t o add item  to the eI V queue
  3625   "RTN","IBC NEUT7",163 ,0)
  3626    N GOOD,GR PNUM,IBIEN ,IBCNMPI,I ENS,IVPIEN ,MCARE,PAT DOB,PATID, PATNM,PATS EX,PAYRNM, PIEN
  3627   "RTN","IBC NEUT7",164 ,0)
  3628    N SUBID,S UBNM,TSITE ,XX
  3629   "RTN","IBC NEUT7",165 ,0)
  3630    S MCARE=$ $GET1^DIQ( 350.9,"1," ,51.25,"E" )    ; Med icare Paye r Name
  3631   "RTN","IBC NEUT7",166 ,0)
  3632    S XX=$G(^ IBCN(365.1 ,TQIEN,0))
  3633   "RTN","IBC NEUT7",167 ,0)
  3634    S (GRPNUM ,PATID,SUB ID,SUBNM)= ""
  3635   "RTN","IBC NEUT7",168 ,0)
  3636    S DFN=$$G ET1^DIQ(36 5.1,TQIEN_ ",",.02,"I ")   ; Pat ient IEN                     
  3637   "RTN","IBC NEUT7",169 ,0)
  3638    S IBCNMPI =$$GET1^DI Q(2,DFN_", ",991.01," I")  ; Int egration C ontrol Num ber MPI
  3639   "RTN","IBC NEUT7",170 ,0)
  3640    S PIEN=$$ GET1^DIQ(3 65.1,TQIEN _",",.03," I")  ; Pay er IEN
  3641   "RTN","IBC NEUT7",171 ,0)
  3642    S IBIEN=$ $GET1^DIQ( 365.1,TQIE N_",",.13, "I") ; Ins urance mul tiple numb er
  3643   "RTN","IBC NEUT7",172 ,0)
  3644    ;
  3645   "RTN","IBC NEUT7",173 ,0)
  3646    ; If the  insurance  multiple i s not in t he transmi ssion queu e, get the
  3647   "RTN","IBC NEUT7",174 ,0)
  3648    ; followi ng fields  from the I nsurance V erificatio n Processo r file
  3649   "RTN","IBC NEUT7",175 ,0)
  3650    I IBIEN=" " D
  3651   "RTN","IBC NEUT7",176 ,0)
  3652    . S IVPIE N=$$GET1^D IQ(365.1,T QIEN_",",. 05,"I") ;  IVP file I EN
  3653   "RTN","IBC NEUT7",177 ,0)
  3654    . S GRPNU M=$$GET1^D IQ(355.33, IVPIEN_"," ,90.02) ;  Group Plan  Number
  3655   "RTN","IBC NEUT7",178 ,0)
  3656    . S PATID =$$GET1^DI Q(355.33,I VPIEN_",", 62.01)  ;  Group Plan  Number
  3657   "RTN","IBC NEUT7",179 ,0)
  3658    . S SUBID =$$GET1^DI Q(355.33,I VPIEN_",", 90.03)  ;  Subscriber  ID
  3659   "RTN","IBC NEUT7",180 ,0)
  3660    . S SUBNM =$$GET1^DI Q(355.33,I VPIEN_",", 91.01)  ;  Subscriber  Name
  3661   "RTN","IBC NEUT7",181 ,0)
  3662    E  D
  3663   "RTN","IBC NEUT7",182 ,0)
  3664    . S IENS= IBIEN_","_ DFN_","
  3665   "RTN","IBC NEUT7",183 ,0)
  3666    . S XX=$$ GET1^DIQ(2 .312,IENS, .18,"I")        ; IEN  of the Gr oup Plan
  3667   "RTN","IBC NEUT7",184 ,0)
  3668    . S GRPNU M=$$GET1^D IQ(355.3,X X_",",2.02 )    ; Gro up Plan Nu mber
  3669   "RTN","IBC NEUT7",185 ,0)
  3670    . S PATID =$$GET1^DI Q(2.312,IE NS,5.01)        ; Pat ient ID
  3671   "RTN","IBC NEUT7",186 ,0)
  3672    . S SUBID =$$GET1^DI Q(2.312,IE NS,1)           ; Sub scriber ID
  3673   "RTN","IBC NEUT7",187 ,0)
  3674    . S SUBNM =$$GET1^DI Q(2.312,IE NS,7.01)        ; Sub scriber NM
  3675   "RTN","IBC NEUT7",188 ,0)
  3676    ;
  3677   "RTN","IBC NEUT7",189 ,0)
  3678    ; First c heck to se e if the s ite is a t est or a p roduction  site
  3679   "RTN","IBC NEUT7",190 ,0)
  3680    S TSITE=$ S($$PROD^X UPROD(1):0 ,1:1)
  3681   "RTN","IBC NEUT7",191 ,0)
  3682    Q:'TSITE  1                                     ; Pro duction si te no chec ks done
  3683   "RTN","IBC NEUT7",192 ,0)
  3684    ;
  3685   "RTN","IBC NEUT7",193 ,0)
  3686    ; Quit if  the Integ ration Con trol Numbe r MPI is n ull - MUST  be presen t
  3687   "RTN","IBC NEUT7",194 ,0)
  3688    Q:IBCNMPI ="" 0
  3689   "RTN","IBC NEUT7",195 ,0)
  3690    ;
  3691   "RTN","IBC NEUT7",196 ,0)
  3692    I (SUBID= "")!(SUBNM ="") Q 0                   ; Key  elements  not define d
  3693   "RTN","IBC NEUT7",197 ,0)
  3694    S XX=$$GE T1^DIQ(2,D FN_",",.03 ,"I")           ; Int ernal Pati ent DOB
  3695   "RTN","IBC NEUT7",198 ,0)
  3696    S PATDOB= $TR($$FMTE ^XLFDT(XX, "7DZ"),"/" ,"") ; YYY YMMDD form at
  3697   "RTN","IBC NEUT7",199 ,0)
  3698    S PATSEX= $$GET1^DIQ (2,DFN_"," ,.02,"I")       ; Pat ient Sex
  3699   "RTN","IBC NEUT7",200 ,0)
  3700    S PATNM=$ $GET1^DIQ( 2,DFN_",", .01,"I")        ; Pat ient Name
  3701   "RTN","IBC NEUT7",201 ,0)
  3702    S PAYRNM= $$GET1^DIQ (365.12,PI EN_",",.01 )    ; Pay er Name
  3703   "RTN","IBC NEUT7",202 ,0)
  3704    S PAYRNM= $$UP^XLFST R(PAYRNM)
  3705   "RTN","IBC NEUT7",203 ,0)
  3706    S GOOD=0
  3707   "RTN","IBC NEUT7",204 ,0)
  3708    ; 
  3709   "RTN","IBC NEUT7",205 ,0)
  3710    ; Profile  P1 Test
  3711   "RTN","IBC NEUT7",206 ,0)
  3712    I PAYRNM= "AETNA",GR PNUM="GRP  NUM 13805" ,SUBID="11 1111AE" D   Q:GOOD 1
  3713   "RTN","IBC NEUT7",207 ,0)
  3714    . Q:SUBNM '="IBSUB,A CTIVE"
  3715   "RTN","IBC NEUT7",208 ,0)
  3716    . Q:PATDO B'="192202 02"
  3717   "RTN","IBC NEUT7",209 ,0)
  3718    . Q:PATSE X'="M"
  3719   "RTN","IBC NEUT7",210 ,0)
  3720    . S GOOD= 1
  3721   "RTN","IBC NEUT7",211 ,0)
  3722    ;
  3723   "RTN","IBC NEUT7",212 ,0)
  3724    ; Profile  P2 Test
  3725   "RTN","IBC NEUT7",213 ,0)
  3726    I PAYRNM= "AETNA",GR PNUM="GRP  NUM 13188" ,SUBID="11 1111FG" D   Q:GOOD 1
  3727   "RTN","IBC NEUT7",214 ,0)
  3728    . Q:SUBNM '="IBSUB,I NACTIVE"
  3729   "RTN","IBC NEUT7",215 ,0)
  3730    . Q:PATDO B'="194801 01"
  3731   "RTN","IBC NEUT7",216 ,0)
  3732    . Q:PATSE X'="F"
  3733   "RTN","IBC NEUT7",217 ,0)
  3734    . S GOOD= 1
  3735   "RTN","IBC NEUT7",218 ,0)
  3736    ;
  3737   "RTN","IBC NEUT7",219 ,0)
  3738    ; Profile  P3 Test
  3739   "RTN","IBC NEUT7",220 ,0)
  3740    I PAYRNM= "CIGNA",GR PNUM="GRP  NUM 5442", SUBID="012 345678" D   Q:GOOD 1
  3741   "RTN","IBC NEUT7",221 ,0)
  3742    . Q:SUBNM '="IBSUB,A AAERROR"
  3743   "RTN","IBC NEUT7",222 ,0)
  3744    . Q:PATDO B'="194702 11"
  3745   "RTN","IBC NEUT7",223 ,0)
  3746    . Q:PATSE X'="M"
  3747   "RTN","IBC NEUT7",224 ,0)
  3748    . S GOOD= 1
  3749   "RTN","IBC NEUT7",225 ,0)
  3750    ;
  3751   "RTN","IBC NEUT7",226 ,0)
  3752    ; Profile  P4 Test
  3753   "RTN","IBC NEUT7",227 ,0)
  3754    I PAYRNM= "AETNA",GR PNUM="AET1 234",SUBID ="W1234561 111" D  Q: GOOD 1
  3755   "RTN","IBC NEUT7",228 ,0)
  3756    . Q:SUBNM '="IBINS,A CTIVE"                    ; Note  this pati ent is mal e
  3757   "RTN","IBC NEUT7",229 ,0)
  3758    . Q:PATID '="W123452 222"
  3759   "RTN","IBC NEUT7",230 ,0)
  3760    . Q:PATNM '="IBDEP,A CTIVE"
  3761   "RTN","IBC NEUT7",231 ,0)
  3762    . Q:PATDO B'="199003 04"
  3763   "RTN","IBC NEUT7",232 ,0)
  3764    . Q:PATSE X'="F"                               ; Note  this is s ubscriber' s spouse
  3765   "RTN","IBC NEUT7",233 ,0)
  3766    . S GOOD= 1
  3767   "RTN","IBC NEUT7",234 ,0)
  3768    ;
  3769   "RTN","IBC NEUT7",235 ,0)
  3770    ; Profile  P5 Test
  3771   "RTN","IBC NEUT7",236 ,0)
  3772    I MCARE'= "",PAYRNM= MCARE,SUBI D="3331133 33A",SUBNM ="IB,PATIE NT" D  Q:G OOD 1
  3773   "RTN","IBC NEUT7",237 ,0)
  3774    . Q:PATDO B'="193503 09"
  3775   "RTN","IBC NEUT7",238 ,0)
  3776    . Q:PATSE X'="M"
  3777   "RTN","IBC NEUT7",239 ,0)
  3778    . S GOOD= 1
  3779   "RTN","IBC NEUT7",240 ,0)
  3780    ;
  3781   "RTN","IBC NEUT7",241 ,0)
  3782    ; Profile  P6 Test
  3783   "RTN","IBC NEUT7",242 ,0)
  3784    I MCARE'= "",PAYRNM= MCARE,SUBI D="1112233 33A",SUBNM ="IBSUB,TW OTRLRS" D   Q:GOOD 1
  3785   "RTN","IBC NEUT7",243 ,0)
  3786    . Q:PATDO B'="195505 05"
  3787   "RTN","IBC NEUT7",244 ,0)
  3788    . Q:PATSE X'="M"
  3789   "RTN","IBC NEUT7",245 ,0)
  3790    . S GOOD= 1
  3791   "RTN","IBC NEUT7",246 ,0)
  3792    ; 
  3793   "RTN","IBC NEUT7",247 ,0)
  3794    ; IB*582/ TAZ - Adde d for test ing "Stop  trigger of  EIV Respo nse"
  3795   "RTN","IBC NEUT7",248 ,0)
  3796    ; Profile  P7 Test
  3797   "RTN","IBC NEUT7",249 ,0)
  3798    I PAYRNM= "AETNA",GR PNUM="GRP  NUM 13805" ,SUBID="22 2222AE" D   Q:GOOD 1
  3799   "RTN","IBC NEUT7",250 ,0)
  3800    . Q:SUBNM '="IBSUB,C ANNOTFIND"
  3801   "RTN","IBC NEUT7",251 ,0)
  3802    . Q:PATDO B'="192207 07"
  3803   "RTN","IBC NEUT7",252 ,0)
  3804    . Q:PATSE X'="M"
  3805   "RTN","IBC NEUT7",253 ,0)
  3806    . S GOOD= 1
  3807   "RTN","IBC NEUT7",254 ,0)
  3808    ;
  3809   "RTN","IBC NEUT7",255 ,0)
  3810    Q 0
  3811   "RTN","IBC NEUT7",256 ,0)
  3812    ;
  3813   "RTN","IBC NEUT7",257 ,0)
  3814   RSTA(REC)  ; Update s tatus in R esponse Fi le from Tr ansmission  Queue to
  3815   "RTN","IBC NEUT7",258 ,0)
  3816    ;          Communica tion Timeo ut
  3817   "RTN","IBC NEUT7",259 ,0)
  3818    ;  Input  Parameters
  3819   "RTN","IBC NEUT7",260 ,0)
  3820    ;    REC  = IEN from  TQ file
  3821   "RTN","IBC NEUT7",261 ,0)
  3822    ;    -- R emoved 10/ 29/02 --WC H = Which  Record 'P' =Previous,  'C'=Curre nt
  3823   "RTN","IBC NEUT7",262 ,0)
  3824    ;    -- i f no Which  Record pa ssed, it w ill assume  the curre nt one
  3825   "RTN","IBC NEUT7",263 ,0)
  3826    ;
  3827   "RTN","IBC NEUT7",264 ,0)
  3828    N HIEN,RI EN
  3829   "RTN","IBC NEUT7",265 ,0)
  3830    S HIEN=0
  3831   "RTN","IBC NEUT7",266 ,0)
  3832    ; Loop th ru HL7 mes sages asso ciated wit h the IIV  Inquiry
  3833   "RTN","IBC NEUT7",267 ,0)
  3834    F  S HIEN =$O(^IBCN( 365.1,REC, 2,HIEN)) Q :'HIEN  D
  3835   "RTN","IBC NEUT7",268 ,0)
  3836    .  ; Dete rmine IIV  Response a ssociated  with the H L7 message
  3837   "RTN","IBC NEUT7",269 ,0)
  3838    .  S RIEN =$P($G(^IB CN(365.1,R EC,2,HIEN, 0)),U,3) Q :'RIEN
  3839   "RTN","IBC NEUT7",270 ,0)
  3840    .  ; If I IV Respons e status i s 'Respons e Received ', don't u pdate it
  3841   "RTN","IBC NEUT7",271 ,0)
  3842    .  I $P($ G(^IBCN(36 5,RIEN,0)) ,U,6)=3 Q
  3843   "RTN","IBC NEUT7",272 ,0)
  3844    .  ; Upda te IIV Res ponse stat us to 'Com munication  Timeout'
  3845   "RTN","IBC NEUT7",273 ,0)
  3846    .  D RSP^ IBCNEUT2(R IEN,5)
  3847   "RTN","IBC NEUT7",274 ,0)
  3848    .  Q
  3849   "RTN","IBC NEUT7",275 ,0)
  3850    ;
  3851   "RTN","IBC NEUT7",276 ,0)
  3852    Q
  3853   "RTN","IBC NEUT7",277 ,0)
  3854    ;
  3855   "RTN","IBC NEUT7",278 ,0)
  3856   TXT(TXT) ; Parse text  for wrapp ing
  3857   "RTN","IBC NEUT7",279 ,0)
  3858    ;  Input  Parameter
  3859   "RTN","IBC NEUT7",280 ,0)
  3860    ;   TXT =  The array  name
  3861   "RTN","IBC NEUT7",281 ,0)
  3862    ;
  3863   "RTN","IBC NEUT7",282 ,0)
  3864    I '$D(@(T XT)) Q
  3865   "RTN","IBC NEUT7",283 ,0)
  3866    ;
  3867   "RTN","IBC NEUT7",284 ,0)
  3868    K ^UTILIT Y($J,"W")
  3869   "RTN","IBC NEUT7",285 ,0)
  3870    ;
  3871   "RTN","IBC NEUT7",286 ,0)
  3872    ;  Define  length of  text stri ng; left i s 1 and ri ght is 78
  3873   "RTN","IBC NEUT7",287 ,0)
  3874    S DIWF="" ,DIWL=1,DI WR=78
  3875   "RTN","IBC NEUT7",288 ,0)
  3876    ;
  3877   "RTN","IBC NEUT7",289 ,0)
  3878    ;  Format  text into  scratch f ile
  3879   "RTN","IBC NEUT7",290 ,0)
  3880    S CT=0
  3881   "RTN","IBC NEUT7",291 ,0)
  3882    F  S CT=$ O(@(TXT)@( CT)) Q:'CT   D
  3883   "RTN","IBC NEUT7",292 ,0)
  3884    . S X=@TX T@(CT) D ^ DIWP
  3885   "RTN","IBC NEUT7",293 ,0)
  3886    ;
  3887   "RTN","IBC NEUT7",294 ,0)
  3888    K @(TXT)
  3889   "RTN","IBC NEUT7",295 ,0)
  3890    ;
  3891   "RTN","IBC NEUT7",296 ,0)
  3892    ;  Reset  formatted  text back  to array
  3893   "RTN","IBC NEUT7",297 ,0)
  3894    S CT=0
  3895   "RTN","IBC NEUT7",298 ,0)
  3896    F  S CT=$ O(^UTILITY ($J,"W",1, CT)) Q:'CT   D
  3897   "RTN","IBC NEUT7",299 ,0)
  3898    . S @(TXT )@(CT)=^UT ILITY($J," W",1,CT,0)
  3899   "RTN","IBC NEUT7",300 ,0)
  3900    ;
  3901   "RTN","IBC NEUT7",301 ,0)
  3902    K ^UTILIT Y($J,"W"), CT,DIWF,DI WL,DIWR,X, Z,DIW,DIWI ,DIWT,DIWT C,DIWX,DN, I
  3903   "RTN","IBC NEUT7",302 ,0)
  3904    Q
  3905   "RTN","IBC NEUT7",303 ,0)
  3906    ;
  3907   "RTN","IBC NEUT7",304 ,0)
  3908   ERRN(ARRAY ) ;  Get t he next Fi leMan erro r number f rom the ar ray
  3909   "RTN","IBC NEUT7",305 ,0)
  3910    ;  Input
  3911   "RTN","IBC NEUT7",306 ,0)
  3912    ;    ARRA Y = the ar ray name,  include "D IERR"
  3913   "RTN","IBC NEUT7",307 ,0)
  3914    ;  Output
  3915   "RTN","IBC NEUT7",308 ,0)
  3916    ;    IBEY  = the nex t error nu mber
  3917   "RTN","IBC NEUT7",309 ,0)
  3918    ;
  3919   "RTN","IBC NEUT7",310 ,0)
  3920    ;  Exampl e call
  3921   "RTN","IBC NEUT7",311 ,0)
  3922    ;    S IE RN=$$ERRN^ IBCNEUT7(" ERROR(""DI ERR"")")
  3923   "RTN","IBC NEUT7",312 ,0)
  3924    ;
  3925   "RTN","IBC NEUT7",313 ,0)
  3926    NEW IBEY
  3927   "RTN","IBC NEUT7",314 ,0)
  3928    ;
  3929   "RTN","IBC NEUT7",315 ,0)
  3930    I '$D(@(A RRAY)) S @ (ARRAY)=1  Q 1
  3931   "RTN","IBC NEUT7",316 ,0)
  3932    ;
  3933   "RTN","IBC NEUT7",317 ,0)
  3934    S IBEY=$P (@(ARRAY), U,1)
  3935   "RTN","IBC NEUT7",318 ,0)
  3936    S IBEY=IB EY+1,$P(@( ARRAY),U,1 )=IBEY
  3937   "RTN","IBC NEUT7",319 ,0)
  3938    Q IBEY
  3939   "RTN","IBC NEUT7",320 ,0)
  3940    ;
  3941   "RTN","IBC NSP02")
  3942   0^4^B16379 800^B15872 106
  3943   "RTN","IBC NSP02",1,0 )
  3944   IBCNSP02 ; ALB/AAS -  INSURANCE  MANAGEMENT  - EXPANDE D POLICY   ; 05-MAR-1 993
  3945   "RTN","IBC NSP02",2,0 )
  3946    ;;2.0;INT EGRATED BI LLING;**58 2**;21-MAR -94;Build  77
  3947   "RTN","IBC NSP02",3,0 )
  3948    ;;Per VA  Directive  6402, this  routine s hould not  be modifie d.
  3949   "RTN","IBC NSP02",4,0 )
  3950    ;
  3951   "RTN","IBC NSP02",5,0 )
  3952   AI ; -- Ad d ins. ver ification  entry
  3953   "RTN","IBC NSP02",6,0 )
  3954    ;    call ed from ai ^ibcnsp1
  3955   "RTN","IBC NSP02",7,0 )
  3956    ;IB*582/T AZ - Insur ance Conta ct informa tion no lo nger enter ed here.
  3957   "RTN","IBC NSP02",8,0 )
  3958    G AIQ
  3959   "RTN","IBC NSP02",9,0 )
  3960    ;
  3961   "RTN","IBC NSP02",10, 0)
  3962    N X,Y,I,J ,DA,DR,DIC ,DIE,DR,DD ,DO,VA,VAI N,VAERR,IB QUIT,IBXIF N,IBTRN,DU OUT,IBX,IB QUIT,DTOUT ,IBA
  3963   "RTN","IBC NSP02",11, 0)
  3964    Q:'$G(DFN )
  3965   "RTN","IBC NSP02",12, 0)
  3966    Q:'$G(IBC DFN)  S IB QUIT=0
  3967   "RTN","IBC NSP02",13, 0)
  3968    ;
  3969   "RTN","IBC NSP02",14, 0)
  3970    ; -- see  if current  inpatient
  3971   "RTN","IBC NSP02",15, 0)
  3972    ;D INP^VA DPT I +VAI N(1) D
  3973   "RTN","IBC NSP02",16, 0)
  3974    S IBA=+$G (^DPT(DFN, .105)) I + IBA S IBTR N=$O(^IBT( 356,"AD",+ IBA,0))
  3975   "RTN","IBC NSP02",17, 0)
  3976    ;
  3977   "RTN","IBC NSP02",18, 0)
  3978    S IBXIFN= $O(^IBE(35 6.11,"ACOD E",85,0))
  3979   "RTN","IBC NSP02",19, 0)
  3980    ;
  3981   "RTN","IBC NSP02",20, 0)
  3982    ; -- if n ot trackin g id allow  selecting
  3983   "RTN","IBC NSP02",21, 0)
  3984    I '$G(IBT RN) D  G:I BQUIT AIQ
  3985   "RTN","IBC NSP02",22, 0)
  3986    .W !,"You  can now e nter a con tact and r elate it t o a Claims  Tracking  Admission  entry."
  3987   "RTN","IBC NSP02",23, 0)
  3988    .S DIC("A ")="Select  RELATED A DMISSION D ATE: "
  3989   "RTN","IBC NSP02",24, 0)
  3990    .S DIC="^ IBT(356,", DIC(0)="AE Q",D="ADFN "_DFN,DIC( "S")="I $P (^(0),U,5) ,$P(^(0),U ,2)=DFN,$P (^(0),U,20 )"
  3991   "RTN","IBC NSP02",25, 0)
  3992    .D IX^DIC  K DA,DR,D IC,DIE I $ D(DUOUT)!( $D(DTOUT))  S IBQUIT= 1 Q
  3993   "RTN","IBC NSP02",26, 0)
  3994    .I +Y>1 S  IBTRN=+Y
  3995   "RTN","IBC NSP02",27, 0)
  3996    ;
  3997   "RTN","IBC NSP02",28, 0)
  3998    ;I '$G(IB TRN) W !!, "Warning:  This conta ct is not  associated  with any  care in Cl aims Track ing.",!,"Y ou may onl y edit or  view this  contact us ing this a ction.",!
  3999   "RTN","IBC NSP02",29, 0)
  4000    ;
  4001   "RTN","IBC NSP02",30, 0)
  4002    ; -- sele ct date
  4003   "RTN","IBC NSP02",31, 0)
  4004    S IBOK=0, IBI=0 F  S  IBI=$O(^I BT(356.2," D",DFN,IBI )) Q:'IBI   I $P($G(^ IBT(356.2, +IBI,0))," ^",4)=IBXI FN,$P($G(^ (1)),"^",5 )=IBCDFN S  IBOK=1
  4005   "RTN","IBC NSP02",32, 0)
  4006    I IBOK D   G:IBQUIT  AIQ
  4007   "RTN","IBC NSP02",33, 0)
  4008    .S DIC="^ IBT(356.2, ",DIC("A") ="Select C ontact Dat e: "
  4009   "RTN","IBC NSP02",34, 0)
  4010    .S X="??" ,DIC(0)="E Q",DIC("S" )="I $P(^( 0),U,5)=DF N,$P($G(^( 1)),U,5)=I BCDFN,$P(^ (0),U,4)=I BXIFN" ;,D LAYGO=356. 2
  4011   "RTN","IBC NSP02",35, 0)
  4012    .S D="ADF N"_DFN
  4013   "RTN","IBC NSP02",36, 0)
  4014    .D IX^DIC  K DIC,DR, DA,DIE,D I  $D(DUOUT) !($D(DTOUT )) S IBQUI T=1
  4015   "RTN","IBC NSP02",37, 0)
  4016    ;
  4017   "RTN","IBC NSP02",38, 0)
  4018    S DIC="^I BT(356.2," ,DIC("A")= "Select Co ntact Date : ",DIC("B ")="TODAY"
  4019   "RTN","IBC NSP02",39, 0)
  4020    S DIC("DR ")=".02/// /"_$G(IBTR N)_";.04// //"_IBXIFN _";.05//// "_DFN_";.1 9////1;1.0 1///NOW;1. 02////"_DU Z_";1.05// //"_IBCDFN
  4021   "RTN","IBC NSP02",40, 0)
  4022    S DIC(0)= "AEQL",DIC ("S")="I $ P(^(0),U,5 )=DFN,$P($ G(^(1)),U, 5)=IBCDFN, $P(^(0),U, 4)=IBXIFN" ,DLAYGO=35 6.2
  4023   "RTN","IBC NSP02",41, 0)
  4024    D ^DIC K  DIC
  4025   "RTN","IBC NSP02",42, 0)
  4026    I $D(DTOU T)!($D(DUO UT))!(+Y<1 ) G AIQ
  4027   "RTN","IBC NSP02",43, 0)
  4028    S IBTRC=+ Y I '$G(IB TRN),$P(^I BT(356.2,+ IBTRC,0)," ^",2) S IB TRN=$P(^(0 ),"^",2)
  4029   "RTN","IBC NSP02",44, 0)
  4030    ;
  4031   "RTN","IBC NSP02",45, 0)
  4032    I '$G(IBT RN) W !!," Warning: T his contac t is not a ssociated  with any c are in Cla ims Tracki ng.",!,"Yo u may only  edit or v iew this c ontact usi ng this ac tion.",! K  IBTRN
  4033   "RTN","IBC NSP02",46, 0)
  4034    ;
  4035   "RTN","IBC NSP02",47, 0)
  4036    I $G(IBTR C),$G(IBTR N),'$P(^IB T(356.2,+I BTRC,0),"^ ",2) S DA= IBTRC,DIE= "^IBT(356. 2,",DR=".0 2////"_$G( IBTRN) D ^ DIE
  4037   "RTN","IBC NSP02",48, 0)
  4038    ;
  4039   "RTN","IBC NSP02",49, 0)
  4040    ; -- edit  ins ver t ype
  4041   "RTN","IBC NSP02",50, 0)
  4042    D EDIT^IB TRCD1("[IB T INS VERI FICATION]" ,1)
  4043   "RTN","IBC NSP02",51, 0)
  4044   AIQ Q
  4045   "RTN","IBC NSP02",52, 0)
  4046    ;
  4047   "RTN","IBC NSP02",53, 0)
  4048   AIP(IBTRC)  ; -- ask  if want to  print a w orksheet
  4049   "RTN","IBC NSP02",54, 0)
  4050    N DIR,DIR UT,DTOUT,D UOUT,IBW,I BCTHDR
  4051   "RTN","IBC NSP02",55, 0)
  4052    I '$D(IBT RN) N IBTR N S IBTRN= $P($G(^IBT (356.2,+$G (IBTRC),0) ),"^",2)
  4053   "RTN","IBC NSP02",56, 0)
  4054    I '$D(DFN ) N DFN S  DFN=$P($G( ^IBT(356,+ $G(IBTRN), 0)),"^",2)
  4055   "RTN","IBC NSP02",57, 0)
  4056    Q:'$G(DFN )!('$G(IBT RN))
  4057   "RTN","IBC NSP02",58, 0)
  4058    W ! S DIR (0)="SOBA^ C:CT SUMMA RY;W:WORKS HEET;B:BOT H;N:NONE"
  4059   "RTN","IBC NSP02",59, 0)
  4060    S DIR("A" )="Print [ C]T Summar y  [W]ork  Sheet (UR)   [N]one   [B]oth: "
  4061   "RTN","IBC NSP02",60, 0)
  4062    S DIR("B" )="NONE"
  4063   "RTN","IBC NSP02",61, 0)
  4064    S DIR("?" )="You may  choose pr int a UR w ork sheet,  a summary  from clai ms trackin g (of this  episode),  both or n othing."
  4065   "RTN","IBC NSP02",62, 0)
  4066    D ^DIR K  DIR
  4067   "RTN","IBC NSP02",63, 0)
  4068    S IBW=Y I  "CWB"'[Y! ($D(DIRUT) ) G AIPQ
  4069   "RTN","IBC NSP02",64, 0)
  4070    S %ZIS="Q M" D ^%ZIS  G:POP AIP Q
  4071   "RTN","IBC NSP02",65, 0)
  4072    I $D(IO(" Q")) S ZTR TN="AIPDQ^ IBCNSP02", ZTSAVE("IB *")="",ZTS AVE("DFN") ="",ZTDESC ="IB - Pri nt UR from  Ins revie w" D ^%ZTL OAD D HOME ^%ZIS G AI PQ
  4073   "RTN","IBC NSP02",66, 0)
  4074    U IO
  4075   "RTN","IBC NSP02",67, 0)
  4076   AIPDQ ; en try point  from taskm an
  4077   "RTN","IBC NSP02",68, 0)
  4078    I IBW="C" !(IBW="B")  S IBCTHDR ="Claims T racking Su mmary" D O NE^IBTOBI  W @IOF
  4079   "RTN","IBC NSP02",69, 0)
  4080    I IBW="W" !(IBW="B")  D DQ^IBTR C4
  4081   "RTN","IBC NSP02",70, 0)
  4082    ;
  4083   "RTN","IBC NSP02",71, 0)
  4084   END I $D(Z TQUEUED) S  ZTREQ="@"  Q
  4085   "RTN","IBC NSP02",72, 0)
  4086    D ^%ZISC
  4087   "RTN","IBC NSP02",73, 0)
  4088    K I,J,X,Y ,%ZIS,VA,I BTRND,IBTR ND1,IBPAG, IBHDT,IBDI SDT,IBETYP ,IBQUIT,IB TAG,DIRUT, DUOUT,IBCN T,IBI,IBJ, IBNAR,IBTN OD,IBTRCD1 ,IBTRTP,IB DA
  4089   "RTN","IBC NSP02",74, 0)
  4090    D KVAR^VA DPT
  4091   "RTN","IBC NSP02",75, 0)
  4092   AIPQ Q
  4093   "RTN","IBY 582PR")
  4094   0^9^B63837 5^n/a
  4095   "RTN","IBY 582PR",1,0 )
  4096   IBY582PR ; EDE/TAZ -  Pre-Instal lation for  IB patch  582 ;
  4097   "RTN","IBY 582PR",2,0 )
  4098    ;;2.0;INT EGRATED BI LLING;**58 2**;21-MAR -94;Build  77
  4099   "RTN","IBY 582PR",3,0 )
  4100    ;;Per VA  Directive  6402, this  routine s hould not  be modifie d.
  4101   "RTN","IBY 582PR",4,0 )
  4102    ;
  4103   "RTN","IBY 582PR",5,0 )
  4104   INC200(Y)  ; function  to determ ine if ent ry in NEW  PERSON FIL E (200) sh ould be in cluded in  the build
  4105   "RTN","IBY 582PR",6,0 )
  4106    ; Y - ien  to file
  4107   "RTN","IBY 582PR",7,0 )
  4108    N DATA,EN TRY,LN,OK, TAG
  4109   "RTN","IBY 582PR",8,0 )
  4110    S OK=0,EN TRY=U_$P($ G(^VA(200, Y,0)),U,1) _U
  4111   "RTN","IBY 582PR",9,0 )
  4112    F LN=2:1  S TAG="ENT 200+"_LN,D ATA=$P($T( @TAG),";;" ,2) Q:DATA =""  I $F( DATA,ENTRY ) S OK=1 Q
  4113   "RTN","IBY 582PR",10, 0)
  4114    Q OK
  4115   "RTN","IBY 582PR",11, 0)
  4116    ;
  4117   "RTN","IBY 582PR",12, 0)
  4118   ENT200 ;En tries in V A(200) to  be include d.
  4119   "RTN","IBY 582PR",13, 0)
  4120    ;
  4121   "RTN","IBY 582PR",14, 0)
  4122    ;;^INTERF ACE,IB EIV ^
  4123   "RTN","IBY 582PR",15, 0)
  4124    ;
  4125   "RTN","IBY 582PR",16, 0)
  4126    ;-------- ---------- ---------- ---------- ---------- ---------- ---------- ---
  4127   "VER")
  4128   8.0^22.2
  4129   "^DD",200, 200,0)
  4130   FIELD^NL^9 000^196
  4131   "^DD",200, 200,0,"DDA ")
  4132   N
  4133   "^DD",200, 200,0,"DT" )
  4134   3050916
  4135   "^DD",200, 200,0,"ID" ,1)
  4136   D EN^DDIOL ("   "_$P( ^(0),U,2), "","?0")
  4137   "^DD",200, 200,0,"ID" ,28)
  4138   D:$D(^(5))  EN^DDIOL( "   "_$P(^ (5),U,2)," ","?0")
  4139   "^DD",200, 200,0,"ID" ,"W8")
  4140   D:$P(^(0), U,9) EN^DD IOL("   "_ $$EXTERNAL ^DILFD(200 ,8,"",$P(^ (0),U,9)), "","?0")
  4141   "^DD",200, 200,0,"IX" ,"A",200,2 )
  4142  
  4143   "^DD",200, 200,0,"IX" ,"A16",200 ,8980.16)
  4144  
  4145   "^DD",200, 200,0,"IX" ,"AB",200. 051,.01)
  4146  
  4147   "^DD",200, 200,0,"IX" ,"AB2",200 ,200.09)
  4148  
  4149   "^DD",200, 200,0,"IX" ,"AC",200, 14.9)
  4150  
  4151   "^DD",200, 200,0,"IX" ,"ACSW",20 0,654.3)
  4152  
  4153   "^DD",200, 200,0,"IX" ,"AD",200. 03,.01)
  4154  
  4155   "^DD",200, 200,0,"IX" ,"ADUPN",2 00,205.5)
  4156  
  4157   "^DD",200, 200,0,"IX" ,"AE",200, .01)
  4158  
  4159   "^DD",200, 200,0,"IX" ,"AF",200, 201)
  4160  
  4161   "^DD",200, 200,0,"IX" ,"AFOF",20 0.032,.01)
  4162  
  4163   "^DD",200, 200,0,"IX" ,"AG",200, .01)
  4164  
  4165   "^DD",200, 200,0,"IX" ,"AH",200. 02,.01)
  4166  
  4167   "^DD",200, 200,0,"IX" ,"AI",200, 201)
  4168  
  4169   "^DD",200, 200,0,"IX" ,"AJ",200, 9)
  4170  
  4171   "^DD",200, 200,0,"IX" ,"AK",200. 051,.01)
  4172  
  4173   "^DD",200, 200,0,"IX" ,"AMPI01", 200,.01)
  4174  
  4175   "^DD",200, 200,0,"IX" ,"AMPI111" ,200,.111)
  4176  
  4177   "^DD",200, 200,0,"IX" ,"AMPI112" ,200,.112)
  4178  
  4179   "^DD",200, 200,0,"IX" ,"AMPI113" ,200,.113)
  4180  
  4181   "^DD",200, 200,0,"IX" ,"AMPI114" ,200,.114)
  4182  
  4183   "^DD",200, 200,0,"IX" ,"AMPI115" ,200,.115)
  4184  
  4185   "^DD",200, 200,0,"IX" ,"AMPI116" ,200,.116)
  4186  
  4187   "^DD",200, 200,0,"IX" ,"AMPI131" ,200,.131)
  4188  
  4189   "^DD",200, 200,0,"IX" ,"AMPI4",2 00,4)
  4190  
  4191   "^DD",200, 200,0,"IX" ,"AMPI4199 ",200,41.9 9)
  4192  
  4193   "^DD",200, 200,0,"IX" ,"AMPI5",2 00,5)
  4194  
  4195   "^DD",200, 200,0,"IX" ,"AMPI532" ,200,53.2)
  4196  
  4197   "^DD",200, 200,0,"IX" ,"AMPI9",2 00,9)
  4198  
  4199   "^DD",200, 200,0,"IX" ,"AMPIV01" ,200.06,.0 1)
  4200  
  4201   "^DD",200, 200,0,"IX" ,"AMPIV3", 200.06,2)
  4202  
  4203   "^DD",200, 200,0,"IX" ,"ANPI",20 0,41.99)
  4204  
  4205   "^DD",200, 200,0,"IX" ,"AOA",200 .03,.01)
  4206  
  4207   "^DD",200, 200,0,"IX" ,"AOAA",20 0,12.5)
  4208  
  4209   "^DD",200, 200,0,"IX" ,"AOB",200 .03,2)
  4210  
  4211   "^DD",200, 200,0,"IX" ,"AOLD",20 0,2)
  4212  
  4213   "^DD",200, 200,0,"IX" ,"AP",200, 201)
  4214  
  4215   "^DD",200, 200,0,"IX" ,"ARA",200 ,11.7)
  4216  
  4217   "^DD",200, 200,0,"IX" ,"ASAN",20 0,501.2)
  4218  
  4219   "^DD",200, 200,0,"IX" ,"ASECID", 200,205.1)
  4220  
  4221   "^DD",200, 200,0,"IX" ,"ASWB",20 0,654)
  4222  
  4223   "^DD",200, 200,0,"IX" ,"ASWC",20 0,654.1)
  4224  
  4225   "^DD",200, 200,0,"IX" ,"ASWD",20 0,654.2)
  4226  
  4227   "^DD",200, 200,0,"IX" ,"ASWE",20 0,654.15)
  4228  
  4229   "^DD",200, 200,0,"IX" ,"ASX",200 ,.01)
  4230  
  4231   "^DD",200, 200,0,"IX" ,"AVPID",2 00,9000)
  4232  
  4233   "^DD",200, 200,0,"IX" ,"AXMIT",2 00,902)
  4234  
  4235   "^DD",200, 200,0,"IX" ,"AXQA",20 0.194,.02)
  4236  
  4237   "^DD",200, 200,0,"IX" ,"AXQAN",2 00.194,.02 )
  4238  
  4239   "^DD",200, 200,0,"IX" ,"B",200,. 01)
  4240  
  4241   "^DD",200, 200,0,"IX" ,"BB",200. 04,.01)
  4242  
  4243   "^DD",200, 200,0,"IX" ,"BS",200, 9)
  4244  
  4245   "^DD",200, 200,0,"IX" ,"BS5",200 ,.01)
  4246  
  4247   "^DD",200, 200,0,"IX" ,"BS55",20 0,9)
  4248  
  4249   "^DD",200, 200,0,"IX" ,"C",200,1 )
  4250  
  4251   "^DD",200, 200,0,"IX" ,"D",200,1 3)
  4252  
  4253   "^DD",200, 200,0,"IX" ,"E",200,2 8)
  4254  
  4255   "^DD",200, 200,0,"IX" ,"E",200,2 9)
  4256  
  4257   "^DD",200, 200,0,"IX" ,"PS1",200 ,53.2)
  4258  
  4259   "^DD",200, 200,0,"IX" ,"PS2",200 ,53.3)
  4260  
  4261   "^DD",200, 200,0,"IX" ,"SSN",200 ,9)
  4262  
  4263   "^DD",200, 200,0,"IX" ,"VOLD",20 0,11)
  4264  
  4265   "^DD",200, 200,0,"NM" ,"NEW PERS ON")
  4266  
  4267   "^DD",200, 200,0,"PT" ,.46,5)
  4268  
  4269   "^DD",200, 200,0,"PT" ,.6,.04)
  4270  
  4271   "^DD",200, 200,0,"PT" ,1,20)
  4272  
  4273   "^DD",200, 200,0,"PT" ,1.1,.04)
  4274  
  4275   "^DD",200, 200,0,"PT" ,1.11,5)
  4276  
  4277   "^DD",200, 200,0,"PT" ,1.11,8)
  4278  
  4279   "^DD",200, 200,0,"PT" ,1.11,9)
  4280  
  4281   "^DD",200, 200,0,"PT" ,1.11,15)
  4282  
  4283   "^DD",200, 200,0,"PT" ,2,.096)
  4284  
  4285   "^DD",200, 200,0,"PT" ,2,.104)
  4286  
  4287   "^DD",200, 200,0,"PT" ,2,.1041)
  4288  
  4289   "^DD",200, 200,0,"PT" ,2,.122)
  4290  
  4291   "^DD",200, 200,0,"PT" ,2,.352)
  4292  
  4293   "^DD",200, 200,0,"PT" ,2,.355)
  4294  
  4295   "^DD",200, 200,0,"PT" ,2,.3616)
  4296  
  4297   "^DD",200, 200,0,"PT" ,2,404.01)
  4298  
  4299   "^DD",200, 200,0,"PT" ,2,1100.02 )
  4300  
  4301   "^DD",200, 200,0,"PT" ,2,1100.04 )
  4302  
  4303   "^DD",200, 200,0,"PT" ,2.0648022 ,7)
  4304  
  4305   "^DD",200, 200,0,"PT" ,2.0648022 ,8)
  4306  
  4307   "^DD",200, 200,0,"PT" ,2.101,4)
  4308  
  4309   "^DD",200, 200,0,"PT" ,2.101,9)
  4310  
  4311   "^DD",200, 200,0,"PT" ,2.2511,2)
  4312  
  4313   "^DD",200, 200,0,"PT" ,2.2512,2)
  4314  
  4315   "^DD",200, 200,0,"PT" ,2.312,1.0 2)
  4316  
  4317   "^DD",200, 200,0,"PT" ,2.312,1.0 4)
  4318  
  4319   "^DD",200, 200,0,"PT" ,2.312,1.0 6)
  4320  
  4321   "^DD",200, 200,0,"PT" ,2.342,.02 )
  4322  
  4323   "^DD",200, 200,0,"PT" ,2.98,14)
  4324  
  4325   "^DD",200, 200,0,"PT" ,2.98,19)
  4326  
  4327   "^DD",200, 200,0,"PT" ,3.05,5)
  4328  
  4329   "^DD",200, 200,0,"PT" ,3.07,.01)
  4330  
  4331   "^DD",200, 200,0,"PT" ,3.07701,1 1)
  4332  
  4333   "^DD",200, 200,0,"PT" ,3.077031, .01)
  4334  
  4335   "^DD",200, 200,0,"PT" ,3.081,.01 )
  4336  
  4337   "^DD",200, 200,0,"PT" ,3.51,4)
  4338  
  4339   "^DD",200, 200,0,"PT" ,3.5131,.0 1)
  4340  
  4341   "^DD",200, 200,0,"PT" ,3.52,.04)
  4342  
  4343   "^DD",200, 200,0,"PT" ,3.7,.01)
  4344  
  4345   "^DD",200, 200,0,"PT" ,3.7,3.2)
  4346  
  4347   "^DD",200, 200,0,"PT" ,3.703,.01 )
  4348  
  4349   "^DD",200, 200,0,"PT" ,3.73,1)
  4350  
  4351   "^DD",200, 200,0,"PT" ,3.8,5)
  4352  
  4353   "^DD",200, 200,0,"PT" ,3.8,5.1)
  4354  
  4355   "^DD",200, 200,0,"PT" ,3.802,.01 )
  4356  
  4357   "^DD",200, 200,0,"PT" ,3.81,.01)
  4358  
  4359   "^DD",200, 200,0,"PT" ,3.91,8.01 )
  4360  
  4361   "^DD",200, 200,0,"PT" ,3.914,2)
  4362  
  4363   "^DD",200, 200,0,"PT" ,4.2995,2)
  4364  
  4365   "^DD",200, 200,0,"PT" ,4.31,2)
  4366  
  4367   "^DD",200, 200,0,"PT" ,9.2,6)
  4368  
  4369   "^DD",200, 200,0,"PT" ,9.24,.01)
  4370  
  4371   "^DD",200, 200,0,"PT" ,9.49,3)
  4372  
  4373   "^DD",200, 200,0,"PT" ,9.4901,.0 3)
  4374  
  4375   "^DD",200, 200,0,"PT" ,9.7,9)
  4376  
  4377   "^DD",200, 200,0,"PT" ,9.823,3)
  4378  
  4379   "^DD",200, 200,0,"PT" ,9.9,13)
  4380  
  4381   "^DD",200, 200,0,"PT" ,14.4,3)
  4382  
  4383   "^DD",200, 200,0,"PT" ,15,.01)
  4384  
  4385   "^DD",200, 200,0,"PT" ,15,.02)
  4386  
  4387   "^DD",200, 200,0,"PT" ,15,.09)
  4388  
  4389   "^DD",200, 200,0,"PT" ,15,.11)
  4390  
  4391   "^DD",200, 200,0,"PT" ,15,.12)
  4392  
  4393   "^DD",200, 200,0,"PT" ,15.02,.03 )
  4394  
  4395   "^DD",200, 200,0,"PT" ,15.121,.0 1)
  4396  
  4397   "^DD",200, 200,0,"PT" ,18.04,.04 )
  4398  
  4399   "^DD",200, 200,0,"PT" ,19,3.6)
  4400  
  4401   "^DD",200, 200,0,"PT" ,19.081,1)
  4402  
  4403   "^DD",200, 200,0,"PT" ,19.2,11)
  4404  
  4405   "^DD",200, 200,0,"PT" ,26.112,.0 1)
  4406  
  4407   "^DD",200, 200,0,"PT" ,26.12,.03 )
  4408  
  4409   "^DD",200, 200,0,"PT" ,26.14,.04 )
  4410  
  4411   "^DD",200, 200,0,"PT" ,26.14,.05 )
  4412  
  4413   "^DD",200, 200,0,"PT" ,26.152,.0 1)
  4414  
  4415   "^DD",200, 200,0,"PT" ,27.11,75. 02)
  4416  
  4417   "^DD",200, 200,0,"PT" ,27.12,.08 )
  4418  
  4419   "^DD",200, 200,0,"PT" ,28.11,.08 )
  4420  
  4421   "^DD",200, 200,0,"PT" ,28.11,1.0 3)
  4422  
  4423   "^DD",200, 200,0,"PT" ,28.11,2.0 3)
  4424  
  4425   "^DD",200, 200,0,"PT" ,29.11,4)
  4426  
  4427   "^DD",200, 200,0,"PT" ,29.11,5)
  4428  
  4429   "^DD",200, 200,0,"PT" ,38.1,3)
  4430  
  4431   "^DD",200, 200,0,"PT" ,38.11,2)
  4432  
  4433   "^DD",200, 200,0,"PT" ,38.5,3)
  4434  
  4435   "^DD",200, 200,0,"PT" ,38.5,5)
  4436  
  4437   "^DD",200, 200,0,"PT" ,39.4,.04)
  4438  
  4439   "^DD",200, 200,0,"PT" ,40.8,26.0 3)
  4440  
  4441   "^DD",200, 200,0,"PT" ,41.1,5)
  4442  
  4443   "^DD",200, 200,0,"PT" ,41.1,11)
  4444  
  4445   "^DD",200, 200,0,"PT" ,41.1,14)
  4446  
  4447   "^DD",200, 200,0,"PT" ,41.41,2)
  4448  
  4449   "^DD",200, 200,0,"PT" ,41.43,2)
  4450  
  4451   "^DD",200, 200,0,"PT" ,42.61,52)
  4452  
  4453   "^DD",200, 200,0,"PT" ,42.702,99 .1)
  4454  
  4455   "^DD",200, 200,0,"PT" ,43,603)
  4456  
  4457   "^DD",200, 200,0,"PT" ,43,720)
  4458  
  4459   "^DD",200, 200,0,"PT" ,43,907)
  4460  
  4461   "^DD",200, 200,0,"PT" ,43.5,.07)
  4462  
  4463   "^DD",200, 200,0,"PT" ,44,16)
  4464  
  4465   "^DD",200, 200,0,"PT" ,44.003,7)
  4466  
  4467   "^DD",200, 200,0,"PT" ,44.003,30 2)
  4468  
  4469   "^DD",200, 200,0,"PT" ,44.003,30 4)
  4470  
  4471   "^DD",200, 200,0,"PT" ,44.04,.01 )
  4472  
  4473   "^DD",200, 200,0,"PT" ,44.1,.01)
  4474  
  4475   "^DD",200, 200,0,"PT" ,45,7)
  4476  
  4477   "^DD",200, 200,0,"PT" ,45,79.1)
  4478  
  4479   "^DD",200, 200,0,"PT" ,45.02,24)
  4480  
  4481   "^DD",200, 200,0,"PT" ,45.03,.01 )
  4482  
  4483   "^DD",200, 200,0,"PT" ,45.06,.02 )
  4484  
  4485   "^DD",200, 200,0,"PT" ,45.06,.03 )
  4486  
  4487   "^DD",200, 200,0,"PT" ,45.5,2)
  4488  
  4489   "^DD",200, 200,0,"PT" ,45.62,.02 )
  4490  
  4491   "^DD",200, 200,0,"PT" ,45.62,.05 )
  4492  
  4493   "^DD",200, 200,0,"PT" ,45.701,.0 1)
  4494  
  4495   "^DD",200, 200,0,"PT" ,45.84,3)
  4496  
  4497   "^DD",200, 200,0,"PT" ,45.84,5)
  4498  
  4499   "^DD",200, 200,0,"PT" ,45.87,.02 )
  4500  
  4501   "^DD",200, 200,0,"PT" ,45.9,82)
  4502  
  4503   "^DD",200, 200,0,"PT" ,45.9,84)
  4504  
  4505   "^DD",200, 200,0,"PT" ,45.9001,1 )
  4506  
  4507   "^DD",200, 200,0,"PT" ,46,.18)
  4508  
  4509   "^DD",200, 200,0,"PT" ,46.1,1.2)
  4510  
  4511   "^DD",200, 200,0,"PT" ,49,2)
  4512  
  4513   "^DD",200, 200,0,"PT" ,49,4)
  4514  
  4515   "^DD",200, 200,0,"PT" ,49,16000)
  4516  
  4517   "^DD",200, 200,0,"PT" ,50.0214,2 )
  4518  
  4519   "^DD",200, 200,0,"PT" ,50.0731,4 )
  4520  
  4521   "^DD",200, 200,0,"PT" ,50.0731,5 )
  4522  
  4523   "^DD",200, 200,0,"PT" ,50.0731,9 )
  4524  
  4525   "^DD",200, 200,0,"PT" ,50.07331, .01)
  4526  
  4527   "^DD",200, 200,0,"PT" ,50.612,7)
  4528  
  4529   "^DD",200, 200,0,"PT" ,50.612,9)
  4530  
  4531   "^DD",200, 200,0,"PT" ,50.807,.0 1)
  4532  
  4533   "^DD",200, 200,0,"PT" ,50.9001,. 01)
  4534  
  4535   "^DD",200, 200,0,"PT" ,50.9004,. 01)
  4536  
  4537   "^DD",200, 200,0,"PT" ,50.901,.0 1)
  4538  
  4539   "^DD",200, 200,0,"PT" ,51.27,1)
  4540  
  4541   "^DD",200, 200,0,"PT" ,52,4)
  4542  
  4543   "^DD",200, 200,0,"PT" ,52,16)
  4544  
  4545   "^DD",200, 200,0,"PT" ,52,23)
  4546  
  4547   "^DD",200, 200,0,"PT" ,52,38)
  4548  
  4549   "^DD",200, 200,0,"PT" ,52,38.1)
  4550  
  4551   "^DD",200, 200,0,"PT" ,52,38.2)
  4552  
  4553   "^DD",200, 200,0,"PT" ,52,84)
  4554  
  4555   "^DD",200, 200,0,"PT" ,52,104)
  4556  
  4557   "^DD",200, 200,0,"PT" ,52,109)
  4558  
  4559   "^DD",200, 200,0,"PT" ,52.0107,2 )
  4560  
  4561   "^DD",200, 200,0,"PT" ,52.032,3)
  4562  
  4563   "^DD",200, 200,0,"PT" ,52.07,8)
  4564  
  4565   "^DD",200, 200,0,"PT" ,52.07,10)
  4566  
  4567   "^DD",200, 200,0,"PT" ,52.07,19)
  4568  
  4569   "^DD",200, 200,0,"PT" ,52.07,24)
  4570  
  4571   "^DD",200, 200,0,"PT" ,52.07,25)
  4572  
  4573   "^DD",200, 200,0,"PT" ,52.07,30)
  4574  
  4575   "^DD",200, 200,0,"PT" ,52.09,.06 )
  4576  
  4577   "^DD",200, 200,0,"PT" ,52.1,4)
  4578  
  4579   "^DD",200, 200,0,"PT" ,52.1,6)
  4580  
  4581   "^DD",200, 200,0,"PT" ,52.1,15)
  4582  
  4583   "^DD",200, 200,0,"PT" ,52.1,19)
  4584  
  4585   "^DD",200, 200,0,"PT" ,52.1,20)
  4586  
  4587   "^DD",200, 200,0,"PT" ,52.1,84)
  4588  
  4589   "^DD",200, 200,0,"PT" ,52.2,.05)
  4590  
  4591   "^DD",200, 200,0,"PT" ,52.2,.07)
  4592  
  4593   "^DD",200, 200,0,"PT" ,52.2,6)
  4594  
  4595   "^DD",200, 200,0,"PT" ,52.2,10)
  4596  
  4597   "^DD",200, 200,0,"PT" ,52.2,11)
  4598  
  4599   "^DD",200, 200,0,"PT" ,52.25,4)
  4600  
  4601   "^DD",200, 200,0,"PT" ,52.25,11)
  4602  
  4603   "^DD",200, 200,0,"PT" ,52.2551,1 )
  4604  
  4605   "^DD",200, 200,0,"PT" ,52.3,.03)
  4606  
  4607   "^DD",200, 200,0,"PT" ,52.4,2)
  4608  
  4609   "^DD",200, 200,0,"PT" ,52.41,4)
  4610  
  4611   "^DD",200, 200,0,"PT" ,52.41,5)
  4612  
  4613   "^DD",200, 200,0,"PT" ,52.41,34)
  4614  
  4615   "^DD",200, 200,0,"PT" ,52.41,37)
  4616  
  4617   "^DD",200, 200,0,"PT" ,52.5,5)
  4618  
  4619   "^DD",200, 200,0,"PT" ,52.51,4)
  4620  
  4621   "^DD",200, 200,0,"PT" ,52.52,2)
  4622  
  4623   "^DD",200, 200,0,"PT" ,52.52,3)
  4624  
  4625   "^DD",200, 200,0,"PT" ,52.8551,. 01)
  4626  
  4627   "^DD",200, 200,0,"PT" ,52.86,2)
  4628  
  4629   "^DD",200, 200,0,"PT" ,52.865,.0 3)
  4630  
  4631   "^DD",200, 200,0,"PT" ,52.8651,2 )
  4632  
  4633   "^DD",200, 200,0,"PT" ,52.87,5)
  4634  
  4635   "^DD",200, 200,0,"PT" ,52.87,14)
  4636  
  4637   "^DD",200, 200,0,"PT" ,53.1,1)
  4638  
  4639   "^DD",200, 200,0,"PT" ,53.1,15)
  4640  
  4641   "^DD",200, 200,0,"PT" ,53.1,16)
  4642  
  4643   "^DD",200, 200,0,"PT" ,53.1,18)
  4644  
  4645   "^DD",200, 200,0,"PT" ,53.1,20)
  4646  
  4647   "^DD",200, 200,0,"PT" ,53.1,22)
  4648  
  4649   "^DD",200, 200,0,"PT" ,53.1,31)
  4650  
  4651   "^DD",200, 200,0,"PT" ,53.1,51)
  4652  
  4653   "^DD",200, 200,0,"PT" ,53.1114,1 )
  4654  
  4655   "^DD",200, 200,0,"PT" ,53.1114,2 )
  4656  
  4657   "^DD",200, 200,0,"PT" ,53.1119,1 )
  4658  
  4659   "^DD",200, 200,0,"PT" ,53.4,.01)
  4660  
  4661   "^DD",200, 200,0,"PT" ,53.44,.01 )
  4662  
  4663   "^DD",200, 200,0,"PT" ,53.45,.01 )
  4664  
  4665   "^DD",200, 200,0,"PT" ,53.68,.03 )
  4666  
  4667   "^DD",200, 200,0,"PT" ,53.68,.22 )
  4668  
  4669   "^DD",200, 200,0,"PT" ,53.69,.03 )
  4670  
  4671   "^DD",200, 200,0,"PT" ,53.77,.01 )
  4672  
  4673   "^DD",200, 200,0,"PT" ,53.78,.03 )
  4674  
  4675   "^DD",200, 200,0,"PT" ,53.79,.05 )
  4676  
  4677   "^DD",200, 200,0,"PT" ,53.79,.07 )
  4678  
  4679   "^DD",200, 200,0,"PT" ,53.79,.23 )
  4680  
  4681   "^DD",200, 200,0,"PT" ,53.79,.29 )
  4682  
  4683   "^DD",200, 200,0,"PT" ,53.793,.0 2)
  4684  
  4685   "^DD",200, 200,0,"PT" ,53.799,.0 2)
  4686  
  4687   "^DD",200, 200,0,"PT" ,53.799,.0 5)
  4688  
  4689   "^DD",200, 200,0,"PT" ,55,57)
  4690  
  4691   "^DD",200, 200,0,"PT" ,55,62.02)
  4692  
  4693   "^DD",200, 200,0,"PT" ,55.01,.06 )
  4694  
  4695   "^DD",200, 200,0,"PT" ,55.01,16)
  4696  
  4697   "^DD",200, 200,0,"PT" ,55.01,135 )
  4698  
  4699   "^DD",200, 200,0,"PT" ,55.01,140 )
  4700  
  4701   "^DD",200, 200,0,"PT" ,55.0108,3 )
  4702  
  4703   "^DD",200, 200,0,"PT" ,55.04,.06 )
  4704  
  4705   "^DD",200, 200,0,"PT" ,55.05,12)
  4706  
  4707   "^DD",200, 200,0,"PT" ,55.051,1)
  4708  
  4709   "^DD",200, 200,0,"PT" ,55.06,1)
  4710  
  4711   "^DD",200, 200,0,"PT" ,55.06,16)
  4712  
  4713   "^DD",200, 200,0,"PT" ,55.06,18)
  4714  
  4715   "^DD",200, 200,0,"PT" ,55.06,20)
  4716  
  4717   "^DD",200, 200,0,"PT" ,55.06,22)
  4718  
  4719   "^DD",200, 200,0,"PT" ,55.06,44)
  4720  
  4721   "^DD",200, 200,0,"PT" ,55.06,47)
  4722  
  4723   "^DD",200, 200,0,"PT" ,55.06,57)
  4724  
  4725   "^DD",200, 200,0,"PT" ,55.06,61)
  4726  
  4727   "^DD",200, 200,0,"PT" ,55.0611,. 06)
  4728  
  4729   "^DD",200, 200,0,"PT" ,55.0611,. 08)
  4730  
  4731   "^DD",200, 200,0,"PT" ,55.1138,1 )
  4732  
  4733   "^DD",200, 200,0,"PT" ,55.1138,2 )
  4734  
  4735   "^DD",200, 200,0,"PT" ,55.6114,1 )
  4736  
  4737   "^DD",200, 200,0,"PT" ,55.6114,2 )
  4738  
  4739   "^DD",200, 200,0,"PT" ,57.62,.01 )
  4740  
  4741   "^DD",200, 200,0,"PT" ,58.19,1)
  4742  
  4743   "^DD",200, 200,0,"PT" ,58.28,2)
  4744  
  4745   "^DD",200, 200,0,"PT" ,58.28,4)
  4746  
  4747   "^DD",200, 200,0,"PT" ,58.351,7)
  4748  
  4749   "^DD",200, 200,0,"PT" ,58.351,10 )
  4750  
  4751   "^DD",200, 200,0,"PT" ,58.3511,1 6)
  4752  
  4753   "^DD",200, 200,0,"PT" ,58.35111, 1)
  4754  
  4755   "^DD",200, 200,0,"PT" ,58.42,7)
  4756  
  4757   "^DD",200, 200,0,"PT" ,58.6,6)
  4758  
  4759   "^DD",200, 200,0,"PT" ,58.6,7)
  4760  
  4761   "^DD",200, 200,0,"PT" ,58.64,2)
  4762  
  4763   "^DD",200, 200,0,"PT" ,58.800118 ,3)
  4764  
  4765   "^DD",200, 200,0,"PT" ,58.800118 ,4)
  4766  
  4767   "^DD",200, 200,0,"PT" ,58.800118 ,6)
  4768  
  4769   "^DD",200, 200,0,"PT" ,58.800118 ,23)
  4770  
  4771   "^DD",200, 200,0,"PT" ,58.81,6)
  4772  
  4773   "^DD",200, 200,0,"PT" ,58.81,18)
  4774  
  4775   "^DD",200, 200,0,"PT" ,58.81,20)
  4776  
  4777   "^DD",200, 200,0,"PT" ,58.81,23)
  4778  
  4779   "^DD",200, 200,0,"PT" ,58.81,25)
  4780  
  4781   "^DD",200, 200,0,"PT" ,58.81,25. 5)
  4782  
  4783   "^DD",200, 200,0,"PT" ,58.81,29)
  4784  
  4785   "^DD",200, 200,0,"PT" ,58.81,30)
  4786  
  4787   "^DD",200, 200,0,"PT" ,58.81,32)
  4788  
  4789   "^DD",200, 200,0,"PT" ,58.81,33)
  4790  
  4791   "^DD",200, 200,0,"PT" ,58.81,49)
  4792  
  4793   "^DD",200, 200,0,"PT" ,58.81,56)
  4794  
  4795   "^DD",200, 200,0,"PT" ,58.81,63. 6)
  4796  
  4797   "^DD",200, 200,0,"PT" ,58.81,65)
  4798  
  4799   "^DD",200, 200,0,"PT" ,58.81,68)
  4800  
  4801   "^DD",200, 200,0,"PT" ,58.81,74)
  4802  
  4803   "^DD",200, 200,0,"PT" ,58.81,78)
  4804  
  4805   "^DD",200, 200,0,"PT" ,58.81,80)
  4806  
  4807   "^DD",200, 200,0,"PT" ,58.81,81)
  4808  
  4809   "^DD",200, 200,0,"PT" ,58.81,83)
  4810  
  4811   "^DD",200, 200,0,"PT" ,58.81,84)
  4812  
  4813   "^DD",200, 200,0,"PT" ,58.8112,1 1)
  4814  
  4815   "^DD",200, 200,0,"PT" ,58.8112,1 2)
  4816  
  4817   "^DD",200, 200,0,"PT" ,58.81125, 6)
  4818  
  4819   "^DD",200, 200,0,"PT" ,58.81125, 8)
  4820  
  4821   "^DD",200, 200,0,"PT" ,58.811259 ,4)
  4822  
  4823   "^DD",200, 200,0,"PT" ,58.811259 ,8)
  4824  
  4825   "^DD",200, 200,0,"PT" ,58.85,12)
  4826  
  4827   "^DD",200, 200,0,"PT" ,58.85,14)
  4828  
  4829   "^DD",200, 200,0,"PT" ,58.85,17)
  4830  
  4831   "^DD",200, 200,0,"PT" ,58.85,20)
  4832  
  4833   "^DD",200, 200,0,"PT" ,58.86,3)
  4834  
  4835   "^DD",200, 200,0,"PT" ,58.86,4)
  4836  
  4837   "^DD",200, 200,0,"PT" ,58.86,9)
  4838  
  4839   "^DD",200, 200,0,"PT" ,58.86,16)
  4840  
  4841   "^DD",200, 200,0,"PT" ,58.87,2)
  4842  
  4843   "^DD",200, 200,0,"PT" ,58.87,6)
  4844  
  4845   "^DD",200, 200,0,"PT" ,58.87,9)
  4846  
  4847   "^DD",200, 200,0,"PT" ,58.89,3)
  4848  
  4849   "^DD",200, 200,0,"PT" ,59.7,20.3 )
  4850  
  4851   "^DD",200, 200,0,"PT" ,59.7,63.5 3)
  4852  
  4853   "^DD",200, 200,0,"PT" ,59.7,70.1 )
  4854  
  4855   "^DD",200, 200,0,"PT" ,59.7,94)
  4856  
  4857   "^DD",200, 200,0,"PT" ,59.731,1)
  4858  
  4859   "^DD",200, 200,0,"PT" ,59.782,1)
  4860  
  4861   "^DD",200, 200,0,"PT" ,60.28,.02 )
  4862  
  4863   "^DD",200, 200,0,"PT" ,61.023,3)
  4864  
  4865   "^DD",200, 200,0,"PT" ,61.223,3)
  4866  
  4867   "^DD",200, 200,0,"PT" ,62.023,3)
  4868  
  4869   "^DD",200, 200,0,"PT" ,62.85,.02 )
  4870  
  4871   "^DD",200, 200,0,"PT" ,63,.101)
  4872  
  4873   "^DD",200, 200,0,"PT" ,63,12.1)
  4874  
  4875   "^DD",200, 200,0,"PT" ,63,13.5)
  4876  
  4877   "^DD",200, 200,0,"PT" ,63,13.6)
  4878  
  4879   "^DD",200, 200,0,"PT" ,63,13.8)
  4880  
  4881   "^DD",200, 200,0,"PT" ,63,14.8)
  4882  
  4883   "^DD",200, 200,0,"PT" ,63,102.1)
  4884  
  4885   "^DD",200, 200,0,"PT" ,63.01,.04 )
  4886  
  4887   "^DD",200, 200,0,"PT" ,63.01,.07 )
  4888  
  4889   "^DD",200, 200,0,"PT" ,63.01,.09 )
  4890  
  4891   "^DD",200, 200,0,"PT" ,63.01,10. 2)
  4892  
  4893   "^DD",200, 200,0,"PT" ,63.01,11. 2)
  4894  
  4895   "^DD",200, 200,0,"PT" ,63.017,.0 4)
  4896  
  4897   "^DD",200, 200,0,"PT" ,63.0171,. 03)
  4898  
  4899   "^DD",200, 200,0,"PT" ,63.02,.02 )
  4900  
  4901   "^DD",200, 200,0,"PT" ,63.02,.02 1)
  4902  
  4903   "^DD",200, 200,0,"PT" ,63.02,.07 )
  4904  
  4905   "^DD",200, 200,0,"PT" ,63.02,.13 )
  4906  
  4907   "^DD",200, 200,0,"PT" ,63.02,.17 1)
  4908  
  4909   "^DD",200, 200,0,"PT" ,63.025,.0 2)
  4910  
  4911   "^DD",200, 200,0,"PT" ,63.0272,. 02)
  4912  
  4913   "^DD",200, 200,0,"PT" ,63.04,.04 )
  4914  
  4915   "^DD",200, 200,0,"PT" ,63.04,.1)
  4916  
  4917   "^DD",200, 200,0,"PT" ,63.041,1)
  4918  
  4919   "^DD",200, 200,0,"PT" ,63.05,.04 )
  4920  
  4921   "^DD",200, 200,0,"PT" ,63.05,.07 )
  4922  
  4923   "^DD",200, 200,0,"PT" ,63.05,11. 55)
  4924  
  4925   "^DD",200, 200,0,"PT" ,63.05,11. 56)
  4926  
  4927   "^DD",200, 200,0,"PT" ,63.05,15. 5)
  4928  
  4929   "^DD",200, 200,0,"PT" ,63.05,19. 5)
  4930  
  4931   "^DD",200, 200,0,"PT" ,63.05,25. 5)
  4932  
  4933   "^DD",200, 200,0,"PT" ,63.05,35)
  4934  
  4935   "^DD",200, 200,0,"PT" ,63.07,6)
  4936  
  4937   "^DD",200, 200,0,"PT" ,63.07,12)
  4938  
  4939   "^DD",200, 200,0,"PT" ,63.08,.02 )
  4940  
  4941   "^DD",200, 200,0,"PT" ,63.08,.02 1)
  4942  
  4943   "^DD",200, 200,0,"PT" ,63.08,.07 )
  4944  
  4945   "^DD",200, 200,0,"PT" ,63.08,.13 )
  4946  
  4947   "^DD",200, 200,0,"PT" ,63.08,.17 1)
  4948  
  4949   "^DD",200, 200,0,"PT" ,63.084,.0 8)
  4950  
  4951   "^DD",200, 200,0,"PT" ,63.085,.0 2)
  4952  
  4953   "^DD",200, 200,0,"PT" ,63.086,.0 2)
  4954  
  4955   "^DD",200, 200,0,"PT" ,63.087,.0 2)
  4956  
  4957   "^DD",200, 200,0,"PT" ,63.09,.02 )
  4958  
  4959   "^DD",200, 200,0,"PT" ,63.09,.02 1)
  4960  
  4961   "^DD",200, 200,0,"PT" ,63.09,.07 )
  4962  
  4963   "^DD",200, 200,0,"PT" ,63.09,.13 )
  4964  
  4965   "^DD",200, 200,0,"PT" ,63.09,.17 1)
  4966  
  4967   "^DD",200, 200,0,"PT" ,63.095,.0 2)
  4968  
  4969   "^DD",200, 200,0,"PT" ,63.097,.0 2)
  4970  
  4971   "^DD",200, 200,0,"PT" ,63.2072,. 02)
  4972  
  4973   "^DD",200, 200,0,"PT" ,63.2072,. 03)
  4974  
  4975   "^DD",200, 200,0,"PT" ,63.242,.0 2)
  4976  
  4977   "^DD",200, 200,0,"PT" ,63.3242,. 02)
  4978  
  4979   "^DD",200, 200,0,"PT" ,63.3242,. 03)
  4980  
  4981   "^DD",200, 200,0,"PT" ,63.5,6)
  4982  
  4983   "^DD",200, 200,0,"PT" ,63.5,12)
  4984  
  4985   "^DD",200, 200,0,"PT" ,63.51,6)
  4986  
  4987   "^DD",200, 200,0,"PT" ,63.51,12)
  4988  
  4989   "^DD",200, 200,0,"PT" ,63.52,6)
  4990  
  4991   "^DD",200, 200,0,"PT" ,63.52,12)
  4992  
  4993   "^DD",200, 200,0,"PT" ,63.53,6)
  4994  
  4995   "^DD",200, 200,0,"PT" ,63.53,12)
  4996  
  4997   "^DD",200, 200,0,"PT" ,63.539,2)
  4998  
  4999   "^DD",200, 200,0,"PT" ,63.8172,. 02)
  5000  
  5001   "^DD",200, 200,0,"PT" ,63.8172,. 03)
  5002  
  5003   "^DD",200, 200,0,"PT" ,63.84,.02 )
  5004  
  5005   "^DD",200, 200,0,"PT" ,63.9072,. 02)
  5006  
  5007   "^DD",200, 200,0,"PT" ,63.9072,. 03)
  5008  
  5009   "^DD",200, 200,0,"PT" ,63.94,.02 )
  5010  
  5011   "^DD",200, 200,0,"PT" ,63.999904 ,.04)
  5012  
  5013   "^DD",200, 200,0,"PT" ,63.999904 ,.1)
  5014  
  5015   "^DD",200, 200,0,"PT" ,63.999904 1,1)
  5016  
  5017   "^DD",200, 200,0,"PT" ,64.03,1)
  5018  
  5019   "^DD",200, 200,0,"PT" ,64.03,22)
  5020  
  5021   "^DD",200, 200,0,"PT" ,64.036,12 )
  5022  
  5023   "^DD",200, 200,0,"PT" ,64.1111,9 )
  5024  
  5025   "^DD",200, 200,0,"PT" ,64.1111,1 5)
  5026  
  5027   "^DD",200, 200,0,"PT" ,64.1111,1 7)
  5028  
  5029   "^DD",200, 200,0,"PT" ,64.1111,2 3)
  5030  
  5031   "^DD",200, 200,0,"PT" ,64.317,4)
  5032  
  5033   "^DD",200, 200,0,"PT" ,64.369,4)
  5034  
  5035   "^DD",200, 200,0,"PT" ,65,.09)
  5036  
  5037   "^DD",200, 200,0,"PT" ,65,4.3)
  5038  
  5039   "^DD",200, 200,0,"PT" ,65,6.6)
  5040  
  5041   "^DD",200, 200,0,"PT" ,65,10.2)
  5042  
  5043   "^DD",200, 200,0,"PT" ,65,11.2)
  5044  
  5045   "^DD",200, 200,0,"PT" ,65.02,.05 )
  5046  
  5047   "^DD",200, 200,0,"PT" ,65.02,.08 )
  5048  
  5049   "^DD",200, 200,0,"PT" ,65.03,.03 )
  5050  
  5051   "^DD",200, 200,0,"PT" ,65.15,.04 )
  5052  
  5053   "^DD",200, 200,0,"PT" ,65.15,.07 )
  5054  
  5055   "^DD",200, 200,0,"PT" ,65.31,.02 )
  5056  
  5057   "^DD",200, 200,0,"PT" ,65.5,.09)
  5058  
  5059   "^DD",200, 200,0,"PT" ,65.5,.12)
  5060  
  5061   "^DD",200, 200,0,"PT" ,65.54,.01 1)
  5062  
  5063   "^DD",200, 200,0,"PT" ,65.54,4.8 )
  5064  
  5065   "^DD",200, 200,0,"PT" ,65.54,10. 2)
  5066  
  5067   "^DD",200, 200,0,"PT" ,65.54,10. 5)
  5068  
  5069   "^DD",200, 200,0,"PT" ,65.54,11. 2)
  5070  
  5071   "^DD",200, 200,0,"PT" ,65.54,11. 5)
  5072  
  5073   "^DD",200, 200,0,"PT" ,65.54,12. 2)
  5074  
  5075   "^DD",200, 200,0,"PT" ,65.54,13. 2)
  5076  
  5077   "^DD",200, 200,0,"PT" ,65.54,14. 2)
  5078  
  5079   "^DD",200, 200,0,"PT" ,65.54,15. 2)
  5080  
  5081   "^DD",200, 200,0,"PT" ,65.54,16. 2)
  5082  
  5083   "^DD",200, 200,0,"PT" ,65.54,17. 2)
  5084  
  5085   "^DD",200, 200,0,"PT" ,65.54,18. 2)
  5086  
  5087   "^DD",200, 200,0,"PT" ,65.54,19. 2)
  5088  
  5089   "^DD",200, 200,0,"PT" ,65.5991,. 02)
  5090  
  5091   "^DD",200, 200,0,"PT" ,65.61,.03 )
  5092  
  5093   "^DD",200, 200,0,"PT" ,65.66,.06 )
  5094  
  5095   "^DD",200, 200,0,"PT" ,65.66,.07 )
  5096  
  5097   "^DD",200, 200,0,"PT" ,66.21,.07 )
  5098  
  5099   "^DD",200, 200,0,"PT" ,66.22,.01 )
  5100  
  5101   "^DD",200, 200,0,"PT" ,67.1,.104 )
  5102  
  5103   "^DD",200, 200,0,"PT" ,67.2,.104 )
  5104  
  5105   "^DD",200, 200,0,"PT" ,67.3,.104 )
  5106  
  5107   "^DD",200, 200,0,"PT" ,67.911,1)
  5108  
  5109   "^DD",200, 200,0,"PT" ,68,.1)
  5110  
  5111   "^DD",200, 200,0,"PT" ,68.02,6.5 )
  5112  
  5113   "^DD",200, 200,0,"PT" ,68.02,6.7 )
  5114  
  5115   "^DD",200, 200,0,"PT" ,68.04,3)
  5116  
  5117   "^DD",200, 200,0,"PT" ,68.14,2)
  5118  
  5119   "^DD",200, 200,0,"PT" ,68.21,3)
  5120  
  5121   "^DD",200, 200,0,"PT" ,69.01,1)
  5122  
  5123   "^DD",200, 200,0,"PT" ,69.01,7)
  5124  
  5125   "^DD",200, 200,0,"PT" ,69.01,12)
  5126  
  5127   "^DD",200, 200,0,"PT" ,69.01,216 61.73)
  5128  
  5129   "^DD",200, 200,0,"PT" ,69.03,10)
  5130  
  5131   "^DD",200, 200,0,"PT" ,69.28,.01 )
  5132  
  5133   "^DD",200, 200,0,"PT" ,69.31,.04 )
  5134  
  5135   "^DD",200, 200,0,"PT" ,69.45,.01 )
  5136  
  5137   "^DD",200, 200,0,"PT" ,69.86,56)
  5138  
  5139   "^DD",200, 200,0,"PT" ,69.87,6)
  5140  
  5141   "^DD",200, 200,0,"PT" ,69.9,617)
  5142  
  5143   "^DD",200, 200,0,"PT" ,70,.06)
  5144  
  5145   "^DD",200, 200,0,"PT" ,70.03,12)
  5146  
  5147   "^DD",200, 200,0,"PT" ,70.03,14)
  5148  
  5149   "^DD",200, 200,0,"PT" ,70.03,15)
  5150  
  5151   "^DD",200, 200,0,"PT" ,70.05,3)
  5152  
  5153   "^DD",200, 200,0,"PT" ,70.07,3)
  5154  
  5155   "^DD",200, 200,0,"PT" ,70.08,3)
  5156  
  5157   "^DD",200, 200,0,"PT" ,70.09,.01 )
  5158  
  5159   "^DD",200, 200,0,"PT" ,70.11,.01 )
  5160  
  5161   "^DD",200, 200,0,"PT" ,70.12,.01 )
  5162  
  5163   "^DD",200, 200,0,"PT" ,70.15,4)
  5164  
  5165   "^DD",200, 200,0,"PT" ,70.16,3)
  5166  
  5167   "^DD",200, 200,0,"PT" ,70.21,3)
  5168  
  5169   "^DD",200, 200,0,"PT" ,70.21,6)
  5170  
  5171   "^DD",200, 200,0,"PT" ,70.21,9)
  5172  
  5173   "^DD",200, 200,0,"PT" ,70.21,10)
  5174  
  5175   "^DD",200, 200,0,"PT" ,71.06,3)
  5176  
  5177   "^DD",200, 200,0,"PT" ,71.98,1)
  5178  
  5179   "^DD",200, 200,0,"PT" ,74,9)
  5180  
  5181   "^DD",200, 200,0,"PT" ,74,11)
  5182  
  5183   "^DD",200, 200,0,"PT" ,74,15)
  5184  
  5185   "^DD",200, 200,0,"PT" ,74,17)
  5186  
  5187   "^DD",200, 200,0,"PT" ,74.01,3)
  5188  
  5189   "^DD",200, 200,0,"PT" ,74.01,7)
  5190  
  5191   "^DD",200, 200,0,"PT" ,74.01,9)
  5192  
  5193   "^DD",200, 200,0,"PT" ,74.18,.01 )
  5194  
  5195   "^DD",200, 200,0,"PT" ,74.19,.01 )
  5196  
  5197   "^DD",200, 200,0,"PT" ,74.2,3)
  5198  
  5199   "^DD",200, 200,0,"PT" ,74.33,3)
  5200  
  5201   "^DD",200, 200,0,"PT" ,74.4,3)
  5202  
  5203   "^DD",200, 200,0,"PT" ,74.4,12)
  5204  
  5205   "^DD",200, 200,0,"PT" ,75.1,8)
  5206  
  5207   "^DD",200, 200,0,"PT" ,75.1,14)
  5208  
  5209   "^DD",200, 200,0,"PT" ,75.1,15)
  5210  
  5211   "^DD",200, 200,0,"PT" ,75.12,3)
  5212  
  5213   "^DD",200, 200,0,"PT" ,79.03,.01 )
  5214  
  5215   "^DD",200, 200,0,"PT" ,79.13,.01 )
  5216  
  5217   "^DD",200, 200,0,"PT" ,79.23,3)
  5218  
  5219   "^DD",200, 200,0,"PT" ,79.3,.06)
  5220  
  5221   "^DD",200, 200,0,"PT" ,90,106)
  5222  
  5223   "^DD",200, 200,0,"PT" ,90,109)
  5224  
  5225   "^DD",200, 200,0,"PT" ,90.01,29)
  5226  
  5227   "^DD",200, 200,0,"PT" ,90.05,2)
  5228  
  5229   "^DD",200, 200,0,"PT" ,90.06,2)
  5230  
  5231   "^DD",200, 200,0,"PT" ,90.07,2)
  5232  
  5233   "^DD",200, 200,0,"PT" ,90.11,2)
  5234  
  5235   "^DD",200, 200,0,"PT" ,90.16,2)
  5236  
  5237   "^DD",200, 200,0,"PT" ,90.17,2)
  5238  
  5239   "^DD",200, 200,0,"PT" ,95.11,5)
  5240  
  5241   "^DD",200, 200,0,"PT" ,95.11,7.5 )
  5242  
  5243   "^DD",200, 200,0,"PT" ,95.11,8)
  5244  
  5245   "^DD",200, 200,0,"PT" ,95.11,14)
  5246  
  5247   "^DD",200, 200,0,"PT" ,99.02,.01 )
  5248  
  5249   "^DD",200, 200,0,"PT" ,99.06,.01 )
  5250  
  5251   "^DD",200, 200,0,"PT" ,99.14,.01 )
  5252  
  5253   "^DD",200, 200,0,"PT" ,99.17,.01 )
  5254  
  5255   "^DD",200, 200,0,"PT" ,99.3,.01)
  5256  
  5257   "^DD",200, 200,0,"PT" ,99.4,.01)
  5258  
  5259   "^DD",200, 200,0,"PT" ,100,1)
  5260  
  5261   "^DD",200, 200,0,"PT" ,100,3)
  5262  
  5263   "^DD",200, 200,0,"PT" ,100,35)
  5264  
  5265   "^DD",200, 200,0,"PT" ,100,62)
  5266  
  5267   "^DD",200, 200,0,"PT" ,100,67)
  5268  
  5269   "^DD",200, 200,0,"PT" ,100.008,3 )
  5270  
  5271   "^DD",200, 200,0,"PT" ,100.008,5 )
  5272  
  5273   "^DD",200, 200,0,"PT" ,100.008,7 )
  5274  
  5275   "^DD",200, 200,0,"PT" ,100.008,8 )
  5276  
  5277   "^DD",200, 200,0,"PT" ,100.008,1 0)
  5278  
  5279   "^DD",200, 200,0,"PT" ,100.008,1 3)
  5280  
  5281   "^DD",200, 200,0,"PT" ,100.008,1 7)
  5282  
  5283   "^DD",200, 200,0,"PT" ,100.008,1 8)
  5284  
  5285   "^DD",200, 200,0,"PT" ,100.008,2 2)
  5286  
  5287   "^DD",200, 200,0,"PT" ,100.008,3 4)
  5288  
  5289   "^DD",200, 200,0,"PT" ,100.008,3 7)
  5290  
  5291   "^DD",200, 200,0,"PT" ,100.008,3 9)
  5292  
  5293   "^DD",200, 200,0,"PT" ,100.008,7 3)
  5294  
  5295   "^DD",200, 200,0,"PT" ,100.05,3)
  5296  
  5297   "^DD",200, 200,0,"PT" ,100.05,14 )
  5298  
  5299   "^DD",200, 200,0,"PT" ,100.09,.0 5)
  5300  
  5301   "^DD",200, 200,0,"PT" ,100.2,6)
  5302  
  5303   "^DD",200, 200,0,"PT" ,100.21,1. 6)
  5304  
  5305   "^DD",200, 200,0,"PT" ,100.212,. 01)
  5306  
  5307   "^DD",200, 200,0,"PT" ,100.213,. 01)
  5308  
  5309   "^DD",200, 200,0,"PT" ,100.24,.0 1)
  5310  
  5311   "^DD",200, 200,0,"PT" ,100.241,. 01)
  5312  
  5313   "^DD",200, 200,0,"PT" ,100.25,3)
  5314  
  5315   "^DD",200, 200,0,"PT" ,100.4,2)
  5316  
  5317   "^DD",200, 200,0,"PT" ,100.512,1 )
  5318  
  5319   "^DD",200, 200,0,"PT" ,100.681,1 )
  5320  
  5321   "^DD",200, 200,0,"PT" ,100.71,.0 1)
  5322  
  5323   "^DD",200, 200,0,"PT" ,101,5)
  5324  
  5325   "^DD",200, 200,0,"PT" ,101.52,31 )
  5326  
  5327   "^DD",200, 200,0,"PT" ,102.21,5)
  5328  
  5329   "^DD",200, 200,0,"PT" ,102.3,2)
  5330  
  5331   "^DD",200, 200,0,"PT" ,102.3,7)
  5332  
  5333   "^DD",200, 200,0,"PT" ,102.3,9)
  5334  
  5335   "^DD",200, 200,0,"PT" ,102.4,2)
  5336  
  5337   "^DD",200, 200,0,"PT" ,112.6,.8)
  5338  
  5339   "^DD",200, 200,0,"PT" ,115,15)
  5340  
  5341   "^DD",200, 200,0,"PT" ,115.011,1 01)
  5342  
  5343   "^DD",200, 200,0,"PT" ,115.012,2 )
  5344  
  5345   "^DD",200, 200,0,"PT" ,115.012,4 )
  5346  
  5347   "^DD",200, 200,0,"PT" ,115.016,1 2)
  5348  
  5349   "^DD",200, 200,0,"PT" ,115.016,1 6)
  5350  
  5351   "^DD",200, 200,0,"PT" ,115.016,2 1.7)
  5352  
  5353   "^DD",200, 200,0,"PT" ,115.016,2 4.5)
  5354  
  5355   "^DD",200, 200,0,"PT" ,115.017,4 )
  5356  
  5357   "^DD",200, 200,0,"PT" ,115.017,5 )
  5358  
  5359   "^DD",200, 200,0,"PT" ,115.017,1 0)
  5360  
  5361   "^DD",200, 200,0,"PT" ,115.018,9 )
  5362  
  5363   "^DD",200, 200,0,"PT" ,115.02,10 )
  5364  
  5365   "^DD",200, 200,0,"PT" ,115.02,16 )
  5366  
  5367   "^DD",200, 200,0,"PT" ,115.02,18 )
  5368  
  5369   "^DD",200, 200,0,"PT" ,115.02,20 )
  5370  
  5371   "^DD",200, 200,0,"PT" ,115.03,4)
  5372  
  5373   "^DD",200, 200,0,"PT" ,115.03,6)
  5374  
  5375   "^DD",200, 200,0,"PT" ,115.03,9)
  5376  
  5377   "^DD",200, 200,0,"PT" ,115.04,10 )
  5378  
  5379   "^DD",200, 200,0,"PT" ,115.04,12 )
  5380  
  5381   "^DD",200, 200,0,"PT" ,115.04,15 )
  5382  
  5383   "^DD",200, 200,0,"PT" ,115.05,4)
  5384  
  5385   "^DD",200, 200,0,"PT" ,115.06,3)
  5386  
  5387   "^DD",200, 200,0,"PT" ,115.06,6)
  5388  
  5389   "^DD",200, 200,0,"PT" ,115.07,2)
  5390  
  5391   "^DD",200, 200,0,"PT" ,115.07,41 )
  5392  
  5393   "^DD",200, 200,0,"PT" ,115.07,43 )
  5394  
  5395   "^DD",200, 200,0,"PT" ,115.08,4)
  5396  
  5397   "^DD",200, 200,0,"PT" ,115.08,6)
  5398  
  5399   "^DD",200, 200,0,"PT" ,115.11,3)
  5400  
  5401   "^DD",200, 200,0,"PT" ,115.1626, 4)
  5402  
  5403   "^DD",200, 200,0,"PT" ,115.1626, 6)
  5404  
  5405   "^DD",200, 200,0,"PT" ,115.1627, 2)
  5406  
  5407   "^DD",200, 200,0,"PT" ,115.1627, 30)
  5408  
  5409   "^DD",200, 200,0,"PT" ,115.1627, 32)
  5410  
  5411   "^DD",200, 200,0,"PT" ,115.7,2)
  5412  
  5413   "^DD",200, 200,0,"PT" ,115.7,101 )
  5414  
  5415   "^DD",200, 200,0,"PT" ,115.7,104 )
  5416  
  5417   "^DD",200, 200,0,"PT" ,119,.01)
  5418  
  5419   "^DD",200, 200,0,"PT" ,119.5,5)
  5420  
  5421   "^DD",200, 200,0,"PT" ,119.6,1)
  5422  
  5423   "^DD",200, 200,0,"PT" ,119.66,.0 1)
  5424  
  5425   "^DD",200, 200,0,"PT" ,119.8,8)
  5426  
  5427   "^DD",200, 200,0,"PT" ,119.9,9)
  5428  
  5429   "^DD",200, 200,0,"PT" ,119.9,10)
  5430  
  5431   "^DD",200, 200,0,"PT" ,119.9,11)
  5432  
  5433   "^DD",200, 200,0,"PT" ,119.9,12)
  5434  
  5435   "^DD",200, 200,0,"PT" ,119.9,13)
  5436  
  5437   "^DD",200, 200,0,"PT" ,119.9,50)
  5438  
  5439   "^DD",200, 200,0,"PT" ,119.9,51)
  5440  
  5441   "^DD",200, 200,0,"PT" ,119.9,52)
  5442  
  5443   "^DD",200, 200,0,"PT" ,119.9,53)
  5444  
  5445   "^DD",200, 200,0,"PT" ,119.9,54)
  5446  
  5447   "^DD",200, 200,0,"PT" ,119.9,55)
  5448  
  5449   "^DD",200, 200,0,"PT" ,119.9,56)
  5450  
  5451   "^DD",200, 200,0,"PT" ,119.9,57)
  5452  
  5453   "^DD",200, 200,0,"PT" ,119.9,58)
  5454  
  5455   "^DD",200, 200,0,"PT" ,119.9,59)
  5456  
  5457   "^DD",200, 200,0,"PT" ,120.5,.06 )
  5458  
  5459   "^DD",200, 200,0,"PT" ,120.5,3)
  5460  
  5461   "^DD",200, 200,0,"PT" ,120.8,5)
  5462  
  5463   "^DD",200, 200,0,"PT" ,120.8,21)
  5464  
  5465   "^DD",200, 200,0,"PT" ,120.8,24)
  5466  
  5467   "^DD",200, 200,0,"PT" ,120.81,2)
  5468  
  5469   "^DD",200, 200,0,"PT" ,120.813,1 )
  5470  
  5471   "^DD",200, 200,0,"PT" ,120.814,1 )
  5472  
  5473   "^DD",200, 200,0,"PT" ,120.826,1 )
  5474  
  5475   "^DD",200, 200,0,"PT" ,120.85,.5 )
  5476  
  5477   "^DD",200, 200,0,"PT" ,120.85,1. 2)
  5478  
  5479   "^DD",200, 200,0,"PT" ,120.8502, 2)
  5480  
  5481   "^DD",200, 200,0,"PT" ,120.86,2)
  5482  
  5483   "^DD",200, 200,0,"PT" ,123,7)
  5484  
  5485   "^DD",200, 200,0,"PT" ,123,10)
  5486  
  5487   "^DD",200, 200,0,"PT" ,123.02,3)
  5488  
  5489   "^DD",200, 200,0,"PT" ,123.02,4)
  5490  
  5491   "^DD",200, 200,0,"PT" ,123.02,7)
  5492  
  5493   "^DD",200, 200,0,"PT" ,123.3,129 )
  5494  
  5495   "^DD",200, 200,0,"PT" ,123.5,5)
  5496  
  5497   "^DD",200, 200,0,"PT" ,123.5,123 .08)
  5498  
  5499   "^DD",200, 200,0,"PT" ,123.5,123 .5)
  5500  
  5501   "^DD",200, 200,0,"PT" ,123.5,135 )
  5502  
  5503   "^DD",200, 200,0,"PT" ,123.54,1)
  5504  
  5505   "^DD",200, 200,0,"PT" ,123.55,.0 1)
  5506  
  5507   "^DD",200, 200,0,"PT" ,123.555,. 01)
  5508  
  5509   "^DD",200, 200,0,"PT" ,124.3,3)
  5510  
  5511   "^DD",200, 200,0,"PT" ,124.3,5.2 )
  5512  
  5513   "^DD",200, 200,0,"PT" ,124.313,2 )
  5514  
  5515   "^DD",200, 200,0,"PT" ,125.8,3)
  5516  
  5517   "^DD",200, 200,0,"PT" ,125.8,7)
  5518  
  5519   "^DD",200, 200,0,"PT" ,126.01,6)
  5520  
  5521   "^DD",200, 200,0,"PT" ,126.02,5)
  5522  
  5523   "^DD",200, 200,0,"PT" ,126.03,6)
  5524  
  5525   "^DD",200, 200,0,"PT" ,126.03,9)
  5526  
  5527   "^DD",200, 200,0,"PT" ,126.313,3 )
  5528  
  5529   "^DD",200, 200,0,"PT" ,126.316,2 )
  5530  
  5531   "^DD",200, 200,0,"PT" ,126.41,4)
  5532  
  5533   "^DD",200, 200,0,"PT" ,130,.12)
  5534  
  5535   "^DD",200, 200,0,"PT" ,130,.14)
  5536  
  5537   "^DD",200, 200,0,"PT" ,130,.15)
  5538  
  5539   "^DD",200, 200,0,"PT" ,130,.16)
  5540  
  5541   "^DD",200, 200,0,"PT" ,130,.164)
  5542  
  5543   "^DD",200, 200,0,"PT" ,130,.167)
  5544  
  5545   "^DD",200, 200,0,"PT" ,130,.168)
  5546  
  5547   "^DD",200, 200,0,"PT" ,130,.18)
  5548  
  5549   "^DD",200, 200,0,"PT" ,130,.31)
  5550  
  5551   "^DD",200, 200,0,"PT" ,130,.32)
  5552  
  5553   "^DD",200, 200,0,"PT" ,130,.33)
  5554  
  5555   "^DD",200, 200,0,"PT" ,130,.34)
  5556  
  5557   "^DD",200, 200,0,"PT" ,130,.522)
  5558  
  5559   "^DD",200, 200,0,"PT" ,130,.525)
  5560  
  5561   "^DD",200, 200,0,"PT" ,130,.57)
  5562  
  5563   "^DD",200, 200,0,"PT" ,130,.69)
  5564  
  5565   "^DD",200, 200,0,"PT" ,130,1.099 )
  5566  
  5567   "^DD",200, 200,0,"PT" ,130,4)
  5568  
  5569   "^DD",200, 200,0,"PT" ,130,5)
  5570  
  5571   "^DD",200, 200,0,"PT" ,130,47)
  5572  
  5573   "^DD",200, 200,0,"PT" ,130,48)
  5574  
  5575   "^DD",200, 200,0,"PT" ,130,61)
  5576  
  5577   "^DD",200, 200,0,"PT" ,130,63)
  5578  
  5579   "^DD",200, 200,0,"PT" ,130,69)
  5580  
  5581   "^DD",200, 200,0,"PT" ,130,70)
  5582  
  5583   "^DD",200, 200,0,"PT" ,130,123)
  5584  
  5585   "^DD",200, 200,0,"PT" ,130,124)
  5586  
  5587   "^DD",200, 200,0,"PT" ,130,272.1 )
  5588  
  5589   "^DD",200, 200,0,"PT" ,130,639)
  5590  
  5591   "^DD",200, 200,0,"PT" ,130,657)
  5592  
  5593   "^DD",200, 200,0,"PT" ,130,659)
  5594  
  5595   "^DD",200, 200,0,"PT" ,130,751)
  5596  
  5597   "^DD",200, 200,0,"PT" ,130,753)
  5598  
  5599   "^DD",200, 200,0,"PT" ,130.01,10 )
  5600  
  5601   "^DD",200, 200,0,"PT" ,130.0129, 3)
  5602  
  5603   "^DD",200, 200,0,"PT" ,130.013,1 )
  5604  
  5605   "^DD",200, 200,0,"PT" ,130.02,2)
  5606  
  5607   "^DD",200, 200,0,"PT" ,130.03,6)
  5608  
  5609   "^DD",200, 200,0,"PT" ,130.06,35 )
  5610  
  5611   "^DD",200, 200,0,"PT" ,130.06,39 )
  5612  
  5613   "^DD",200, 200,0,"PT" ,130.23,.0 1)
  5614  
  5615   "^DD",200, 200,0,"PT" ,130.28,.0 1)
  5616  
  5617   "^DD",200, 200,0,"PT" ,130.31,1)
  5618  
  5619   "^DD",200, 200,0,"PT" ,130.34,2)
  5620  
  5621   "^DD",200, 200,0,"PT" ,130.34,3)
  5622  
  5623   "^DD",200, 200,0,"PT" ,130.36,.0 1)
  5624  
  5625   "^DD",200, 200,0,"PT" ,130.39,2)
  5626  
  5627   "^DD",200, 200,0,"PT" ,130.41,3)
  5628  
  5629   "^DD",200, 200,0,"PT" ,131.7,2)
  5630  
  5631   "^DD",200, 200,0,"PT" ,131.704,2 )
  5632  
  5633   "^DD",200, 200,0,"PT" ,133.361,. 01)
  5634  
  5635   "^DD",200, 200,0,"PT" ,133.8013, 6)
  5636  
  5637   "^DD",200, 200,0,"PT" ,136.011,. 01)
  5638  
  5639   "^DD",200, 200,0,"PT" ,142,.06)
  5640  
  5641   "^DD",200, 200,0,"PT" ,142.5,.17 )
  5642  
  5643   "^DD",200, 200,0,"PT" ,142.98,.0 1)
  5644  
  5645   "^DD",200, 200,0,"PT" ,142.99,.0 6)
  5646  
  5647   "^DD",200, 200,0,"PT" ,154,.06)
  5648  
  5649   "^DD",200, 200,0,"PT" ,154,8.1)
  5650  
  5651   "^DD",200, 200,0,"PT" ,154,8.2)
  5652  
  5653   "^DD",200, 200,0,"PT" ,154.101,. 01)
  5654  
  5655   "^DD",200, 200,0,"PT" ,154.9101, .01)
  5656  
  5657   "^DD",200, 200,0,"PT" ,160.04,11 )
  5658  
  5659   "^DD",200, 200,0,"PT" ,160.18,.0 1)
  5660  
  5661   "^DD",200, 200,0,"PT" ,160.25,.0 1)
  5662  
  5663   "^DD",200, 200,0,"PT" ,161.01,10 0)
  5664  
  5665   "^DD",200, 200,0,"PT" ,161.01,10 4)
  5666  
  5667   "^DD",200, 200,0,"PT" ,161.011,3 )
  5668  
  5669   "^DD",200, 200,0,"PT" ,161.02,10 0)
  5670  
  5671   "^DD",200, 200,0,"PT" ,161.192,1 )
  5672  
  5673   "^DD",200, 200,0,"PT" ,161.193,4 )
  5674  
  5675   "^DD",200, 200,0,"PT" ,161.24,.0 4)
  5676  
  5677   "^DD",200, 200,0,"PT" ,161.5,18)
  5678  
  5679   "^DD",200, 200,0,"PT" ,161.517,2 )
  5680  
  5681   "^DD",200, 200,0,"PT" ,161.7,4)
  5682  
  5683   "^DD",200, 200,0,"PT" ,161.7,6)
  5684  
  5685   "^DD",200, 200,0,"PT" ,161.7,14)
  5686  
  5687   "^DD",200, 200,0,"PT" ,161.7,23)
  5688  
  5689   "^DD",200, 200,0,"PT" ,161.831,3 )
  5690  
  5691   "^DD",200, 200,0,"PT" ,162.03,6)
  5692  
  5693   "^DD",200, 200,0,"PT" ,162.03,25 )
  5694  
  5695   "^DD",200, 200,0,"PT" ,162.1,2)
  5696  
  5697   "^DD",200, 200,0,"PT" ,162.11,11 )
  5698  
  5699   "^DD",200, 200,0,"PT" ,162.11,24 )
  5700  
  5701   "^DD",200, 200,0,"PT" ,162.2,7)
  5702  
  5703   "^DD",200, 200,0,"PT" ,162.2,10)
  5704  
  5705   "^DD",200, 200,0,"PT" ,162.2,13)
  5706  
  5707   "^DD",200, 200,0,"PT" ,162.2,17)
  5708  
  5709   "^DD",200, 200,0,"PT" ,162.292,1 )
  5710  
  5711   "^DD",200, 200,0,"PT" ,162.4,.01 3)
  5712  
  5713   "^DD",200, 200,0,"PT" ,162.4,8)
  5714  
  5715   "^DD",200, 200,0,"PT" ,162.4,15)
  5716  
  5717   "^DD",200, 200,0,"PT" ,162.492,1 )
  5718  
  5719   "^DD",200, 200,0,"PT" ,162.5,17)
  5720  
  5721   "^DD",200, 200,0,"PT" ,162.7,23)
  5722  
  5723   "^DD",200, 200,0,"PT" ,162.7,27)
  5724  
  5725   "^DD",200, 200,0,"PT" ,162.701,. 02)
  5726  
  5727   "^DD",200, 200,0,"PT" ,162.792,1 )
  5728  
  5729   "^DD",200, 200,0,"PT" ,162.793,4 )
  5730  
  5731   "^DD",200, 200,0,"PT" ,162.8,.06 )
  5732  
  5733   "^DD",200, 200,0,"PT" ,162.8,.07 )
  5734  
  5735   "^DD",200, 200,0,"PT" ,163.7,7)
  5736  
  5737   "^DD",200, 200,0,"PT" ,165,100)
  5738  
  5739   "^DD",200, 200,0,"PT" ,165.5,64. 1)
  5740  
  5741   "^DD",200, 200,0,"PT" ,165.5,92)
  5742  
  5743   "^DD",200, 200,0,"PT" ,165.5,199 )
  5744  
  5745   "^DD",200, 200,0,"PT" ,165.5,244 )
  5746  
  5747   "^DD",200, 200,0,"PT" ,183,.01)
  5748  
  5749   "^DD",200, 200,0,"PT" ,183.21,1)
  5750  
  5751   "^DD",200, 200,0,"PT" ,183.21,3)
  5752  
  5753   "^DD",200, 200,0,"PT" ,183.32,.0 1)
  5754  
  5755   "^DD",200, 200,0,"PT" ,183.41,.0 1)
  5756  
  5757   "^DD",200, 200,0,"PT" ,190,107)
  5758  
  5759   "^DD",200, 200,0,"PT" ,190.1,3)
  5760  
  5761   "^DD",200, 200,0,"PT" ,190.1,8)
  5762  
  5763   "^DD",200, 200,0,"PT" ,190.2,3)
  5764  
  5765   "^DD",200, 200,0,"PT" ,190.2,8)
  5766  
  5767   "^DD",200, 200,0,"PT" ,190.2,9)
  5768  
  5769   "^DD",200, 200,0,"PT" ,190.3,3)
  5770  
  5771   "^DD",200, 200,0,"PT" ,190.3,7)
  5772  
  5773   "^DD",200, 200,0,"PT" ,190.3,10)
  5774  
  5775   "^DD",200, 200,0,"PT" ,194.2,3)
  5776  
  5777   "^DD",200, 200,0,"PT" ,194.2,8)
  5778  
  5779   "^DD",200, 200,0,"PT" ,195.9,.01 )
  5780  
  5781   "^DD",200, 200,0,"PT" ,200,19)
  5782  
  5783   "^DD",200, 200,0,"PT" ,200,31)
  5784  
  5785   "^DD",200, 200,0,"PT" ,200,53.8)
  5786  
  5787   "^DD",200, 200,0,"PT" ,200,53.96 )
  5788  
  5789   "^DD",200, 200,0,"PT" ,200,654.1 )
  5790  
  5791   "^DD",200, 200,0,"PT" ,200,654.3 )
  5792  
  5793   "^DD",200, 200,0,"PT" ,200.051,1 )
  5794  
  5795   "^DD",200, 200,0,"PT" ,200.052,1 )
  5796  
  5797   "^DD",200, 200,0,"PT" ,200.19,1)
  5798  
  5799   "^DD",200, 200,0,"PT" ,210,.01)
  5800  
  5801   "^DD",200, 200,0,"PT" ,210.03,1. 6)
  5802  
  5803   "^DD",200, 200,0,"PT" ,210.18,1)
  5804  
  5805   "^DD",200, 200,0,"PT" ,211.414,. 01)
  5806  
  5807   "^DD",200, 200,0,"PT" ,211.415,. 01)
  5808  
  5809   "^DD",200, 200,0,"PT" ,211.82,.0 2)
  5810  
  5811   "^DD",200, 200,0,"PT" ,213.4,10)
  5812  
  5813   "^DD",200, 200,0,"PT" ,213.52,.0 1)
  5814  
  5815   "^DD",200, 200,0,"PT" ,214.6,4)
  5816  
  5817   "^DD",200, 200,0,"PT" ,214.7,3)
  5818  
  5819   "^DD",200, 200,0,"PT" ,216.82,1)
  5820  
  5821   "^DD",200, 200,0,"PT" ,216.83,1)
  5822  
  5823   "^DD",200, 200,0,"PT" ,216.84,2)
  5824  
  5825   "^DD",200, 200,0,"PT" ,217,1)
  5826  
  5827   "^DD",200, 200,0,"PT" ,220.5,.01 )
  5828  
  5829   "^DD",200, 200,0,"PT" ,221,60)
  5830  
  5831   "^DD",200, 200,0,"PT" ,222,60)
  5832  
  5833   "^DD",200, 200,0,"PT" ,223,60)
  5834  
  5835   "^DD",200, 200,0,"PT" ,224,60)
  5836  
  5837   "^DD",200, 200,0,"PT" ,226,60)
  5838  
  5839   "^DD",200, 200,0,"PT" ,227,.02)
  5840  
  5841   "^DD",200, 200,0,"PT" ,228.1,.04 )
  5842  
  5843   "^DD",200, 200,0,"PT" ,228.1,.07 )
  5844  
  5845   "^DD",200, 200,0,"PT" ,228.1,.08 )
  5846  
  5847   "^DD",200, 200,0,"PT" ,228.1,1.0 2)
  5848  
  5849   "^DD",200, 200,0,"PT" ,228.2,.03 )
  5850  
  5851   "^DD",200, 200,0,"PT" ,228.2,1.0 2)
  5852  
  5853   "^DD",200, 200,0,"PT" ,228.2,1.0 4)
  5854  
  5855   "^DD",200, 200,0,"PT" ,228.5,.03 )
  5856  
  5857   "^DD",200, 200,0,"PT" ,228.5,.1)
  5858  
  5859   "^DD",200, 200,0,"PT" ,228.7,.02 )
  5860  
  5861   "^DD",200, 200,0,"PT" ,228.7,.06 )
  5862  
  5863   "^DD",200, 200,0,"PT" ,230,.072)
  5864  
  5865   "^DD",200, 200,0,"PT" ,230,.074)
  5866  
  5867   "^DD",200, 200,0,"PT" ,230,3.5)
  5868  
  5869   "^DD",200, 200,0,"PT" ,230,3.6)
  5870  
  5871   "^DD",200, 200,0,"PT" ,230,3.7)
  5872  
  5873   "^DD",200, 200,0,"PT" ,230.1,.03 )
  5874  
  5875   "^DD",200, 200,0,"PT" ,230.1,.07 2)
  5876  
  5877   "^DD",200, 200,0,"PT" ,230.1,.07 4)
  5878  
  5879   "^DD",200, 200,0,"PT" ,230.1,3.5 )
  5880  
  5881   "^DD",200, 200,0,"PT" ,230.1,3.6 )
  5882  
  5883   "^DD",200, 200,0,"PT" ,230.1,3.7 )
  5884  
  5885   "^DD",200, 200,0,"PT" ,231.7,.01 )
  5886  
  5887   "^DD",200, 200,0,"PT" ,234,3)
  5888  
  5889   "^DD",200, 200,0,"PT" ,301.61,1. 02)
  5890  
  5891   "^DD",200, 200,0,"PT" ,301.61,1. 04)
  5892  
  5893   "^DD",200, 200,0,"PT" ,301.62,.0 4)
  5894  
  5895   "^DD",200, 200,0,"PT" ,301.7,2)
  5896  
  5897   "^DD",200, 200,0,"PT" ,301.7,5)
  5898  
  5899   "^DD",200, 200,0,"PT" ,340,.01)
  5900  
  5901   "^DD",200, 200,0,"PT" ,341,.08)
  5902  
  5903   "^DD",200, 200,0,"PT" ,342.31,.0 1)
  5904  
  5905   "^DD",200, 200,0,"PT" ,344,.02)
  5906  
  5907   "^DD",200, 200,0,"PT" ,344,.07)
  5908  
  5909   "^DD",200, 200,0,"PT" ,344,.11)
  5910  
  5911   "^DD",200, 200,0,"PT" ,344.01,.1 2)
  5912  
  5913   "^DD",200, 200,0,"PT" ,344.01,.1 4)
  5914  
  5915   "^DD",200, 200,0,"PT" ,344.01,3. 03)
  5916  
  5917   "^DD",200, 200,0,"PT" ,344.01,3. 05)
  5918  
  5919   "^DD",200, 200,0,"PT" ,344.1,.06 )
  5920  
  5921   "^DD",200, 200,0,"PT" ,344.1,.08 )
  5922  
  5923   "^DD",200, 200,0,"PT" ,344.1,.1)
  5924  
  5925   "^DD",200, 200,0,"PT" ,344.31,.1 7)
  5926  
  5927   "^DD",200, 200,0,"PT" ,344.314,. 03)
  5928  
  5929   "^DD",200, 200,0,"PT" ,344.4,.16 )
  5930  
  5931   "^DD",200, 200,0,"PT" ,344.4,7.0 2)
  5932  
  5933   "^DD",200, 200,0,"PT" ,344.4,20. 02)
  5934  
  5935   "^DD",200, 200,0,"PT" ,344.41,4. 02)
  5936  
  5937   "^DD",200, 200,0,"PT" ,344.491,. 12)
  5938  
  5939   "^DD",200, 200,0,"PT" ,344.491,2 .01)
  5940  
  5941   "^DD",200, 200,0,"PT" ,344.491,2 .03)
  5942  
  5943   "^DD",200, 200,0,"PT" ,344.4914, .02)
  5944  
  5945   "^DD",200, 200,0,"PT" ,344.492,. 01)
  5946  
  5947   "^DD",200, 200,0,"PT" ,344.493,. 04)
  5948  
  5949   "^DD",200, 200,0,"PT" ,344.6,.04 )
  5950  
  5951   "^DD",200, 200,0,"PT" ,344.61,22 )
  5952  
  5953   "^DD",200, 200,0,"PT" ,344.61,23 )
  5954  
  5955   "^DD",200, 200,0,"PT" ,344.62,.0 4)
  5956  
  5957   "^DD",200, 200,0,"PT" ,344.7,.03 )
  5958  
  5959   "^DD",200, 200,0,"PT" ,344.71,.0 2)
  5960  
  5961   "^DD",200, 200,0,"PT" ,344.72,.0 2)
  5962  
  5963   "^DD",200, 200,0,"PT" ,349.11,.0 1)
  5964  
  5965   "^DD",200, 200,0,"PT" ,350,11)
  5966  
  5967   "^DD",200, 200,0,"PT" ,350,13)
  5968  
  5969   "^DD",200, 200,0,"PT" ,350.6,1.0 3)
  5970  
  5971   "^DD",200, 200,0,"PT" ,350.6,2.0 3)
  5972  
  5973   "^DD",200, 200,0,"PT" ,350.6,3.0 3)
  5974  
  5975   "^DD",200, 200,0,"PT" ,350.9,1.0 8)
  5976  
  5977   "^DD",200, 200,0,"PT" ,350.9,51. 16)
  5978  
  5979   "^DD",200, 200,0,"PT" ,350.9,51. 24)
  5980  
  5981   "^DD",200, 200,0,"PT" ,351,11)
  5982  
  5983   "^DD",200, 200,0,"PT" ,351,13)
  5984  
  5985   "^DD",200, 200,0,"PT" ,351.1,.03 )
  5986  
  5987   "^DD",200, 200,0,"PT" ,351.1,.05 )
  5988  
  5989   "^DD",200, 200,0,"PT" ,351.2,2.0 1)
  5990  
  5991   "^DD",200, 200,0,"PT" ,351.2,2.0 3)
  5992  
  5993   "^DD",200, 200,0,"PT" ,351.5,6.0 2)
  5994  
  5995   "^DD",200, 200,0,"PT" ,351.73,.0 1)
  5996  
  5997   "^DD",200, 200,0,"PT" ,351.73,.0 3)
  5998  
  5999   "^DD",200, 200,0,"PT" ,351.731,. 04)
  6000  
  6001   "^DD",200, 200,0,"PT" ,351.81,4. 01)
  6002  
  6003   "^DD",200, 200,0,"PT" ,351.81,4. 03)
  6004  
  6005   "^DD",200, 200,0,"PT" ,351.9,.05 )
  6006  
  6007   "^DD",200, 200,0,"PT" ,351.9,.07 )
  6008  
  6009   "^DD",200, 200,0,"PT" ,351.9,.09 )
  6010  
  6011   "^DD",200, 200,0,"PT" ,351.9,.11 )
  6012  
  6013   "^DD",200, 200,0,"PT" ,351.9,.12 )
  6014  
  6015   "^DD",200, 200,0,"PT" ,351.9,.14 )
  6016  
  6017   "^DD",200, 200,0,"PT" ,354.1,.07 )
  6018  
  6019   "^DD",200, 200,0,"PT" ,354.4,.03 )
  6020  
  6021   "^DD",200, 200,0,"PT" ,354.5002, .01)
  6022  
  6023   "^DD",200, 200,0,"PT" ,354.71,.1 4)
  6024  
  6025   "^DD",200, 200,0,"PT" ,354.71,.1 6)
  6026  
  6027   "^DD",200, 200,0,"PT" ,355.3,1.0 2)
  6028  
  6029   "^DD",200, 200,0,"PT" ,355.3,1.0 4)
  6030  
  6031   "^DD",200, 200,0,"PT" ,355.3,1.0 6)
  6032  
  6033   "^DD",200, 200,0,"PT" ,355.32,1. 02)
  6034  
  6035   "^DD",200, 200,0,"PT" ,355.32,1. 04)
  6036  
  6037   "^DD",200, 200,0,"PT" ,355.33,.0 2)
  6038  
  6039   "^DD",200, 200,0,"PT" ,355.33,.0 6)
  6040  
  6041   "^DD",200, 200,0,"PT" ,355.33,.1 1)
  6042  
  6043   "^DD",200, 200,0,"PT" ,355.4,1.0 2)
  6044  
  6045   "^DD",200, 200,0,"PT" ,355.4,1.0 4)
  6046  
  6047   "^DD",200, 200,0,"PT" ,355.4,1.0 6)
  6048  
  6049   "^DD",200, 200,0,"PT" ,355.5,1.0 2)
  6050  
  6051   "^DD",200, 200,0,"PT" ,355.5,1.0 4)
  6052  
  6053   "^DD",200, 200,0,"PT" ,355.5,1.0 6)
  6054  
  6055   "^DD",200, 200,0,"PT" ,355.9,.01 )
  6056  
  6057   "^DD",200, 200,0,"PT" ,355.9301, .04)
  6058  
  6059   "^DD",200, 200,0,"PT" ,355.935,. 02)
  6060  
  6061   "^DD",200, 200,0,"PT" ,355.9351, .03)
  6062  
  6063   "^DD",200, 200,0,"PT" ,356,1.02)
  6064  
  6065   "^DD",200, 200,0,"PT" ,356,1.04)
  6066  
  6067   "^DD",200, 200,0,"PT" ,356,1.05)
  6068  
  6069   "^DD",200, 200,0,"PT" ,356,1.06)
  6070  
  6071   "^DD",200, 200,0,"PT" ,356,2.01)
  6072  
  6073   "^DD",200, 200,0,"PT" ,356,2.02)
  6074  
  6075   "^DD",200, 200,0,"PT" ,356,2.03)
  6076  
  6077   "^DD",200, 200,0,"PT" ,356.1,1.0 2)
  6078  
  6079   "^DD",200, 200,0,"PT" ,356.1,1.0 4)
  6080  
  6081   "^DD",200, 200,0,"PT" ,356.1,1.0 6)
  6082  
  6083   "^DD",200, 200,0,"PT" ,356.2,1.0 2)
  6084  
  6085   "^DD",200, 200,0,"PT" ,356.2,1.0 4)
  6086  
  6087   "^DD",200, 200,0,"PT" ,356.22,.0 9)
  6088  
  6089   "^DD",200, 200,0,"PT" ,356.22,.1 1)
  6090  
  6091   "^DD",200, 200,0,"PT" ,356.22,.2 4)
  6092  
  6093   "^DD",200, 200,0,"PT" ,356.221,. 02)
  6094  
  6095   "^DD",200, 200,0,"PT" ,356.2213, .03)
  6096  
  6097   "^DD",200, 200,0,"PT" ,356.22168 ,.03)
  6098  
  6099   "^DD",200, 200,0,"PT" ,356.25,1. 02)
  6100  
  6101   "^DD",200, 200,0,"PT" ,356.25,1. 04)
  6102  
  6103   "^DD",200, 200,0,"PT" ,356.26,1. 02)
  6104  
  6105   "^DD",200, 200,0,"PT" ,356.26,1. 04)
  6106  
  6107   "^DD",200, 200,0,"PT" ,356.94,.0 3)
  6108  
  6109   "^DD",200, 200,0,"PT" ,357.03,.0 4)
  6110  
  6111   "^DD",200, 200,0,"PT" ,357.3,4.0 2)
  6112  
  6113   "^DD",200, 200,0,"PT" ,357.96,.1 6)
  6114  
  6115   "^DD",200, 200,0,"PT" ,357.963,. 05)
  6116  
  6117   "^DD",200, 200,0,"PT" ,359.3,.13 )
  6118  
  6119   "^DD",200, 200,0,"PT" ,359.3,1.0 3)
  6120  
  6121   "^DD",200, 200,0,"PT" ,361.02,.0 2)
  6122  
  6123   "^DD",200, 200,0,"PT" ,361.1,.18 )
  6124  
  6125   "^DD",200, 200,0,"PT" ,361.1,100 .03)
  6126  
  6127   "^DD",200, 200,0,"PT" ,361.1101, .02)
  6128  
  6129   "^DD",200, 200,0,"PT" ,361.121,. 02)
  6130  
  6131   "^DD",200, 200,0,"PT" ,361.3,.03 )
  6132  
  6133   "^DD",200, 200,0,"PT" ,361.3,.05 )
  6134  
  6135   "^DD",200, 200,0,"PT" ,361.41,.0 3)
  6136  
  6137   "^DD",200, 200,0,"PT" ,364.1,1.0 2)
  6138  
  6139   "^DD",200, 200,0,"PT" ,364.1,1.0 4)
  6140  
  6141   "^DD",200, 200,0,"PT" ,364.2,1.0 4)
  6142  
  6143   "^DD",200, 200,0,"PT" ,364.4,10. 01)
  6144  
  6145   "^DD",200, 200,0,"PT" ,364.4,10. 03)
  6146  
  6147   "^DD",200, 200,0,"PT" ,365.11,.0 4)
  6148  
  6149   "^DD",200, 200,0,"PT" ,365.11,.0 6)
  6150  
  6151   "^DD",200, 200,0,"PT" ,365.121,. 04)
  6152  
  6153   "^DD",200, 200,0,"PT" ,365.21,.0 2)
  6154  
  6155   "^DD",200, 200,0,"PT" ,366,.09)
  6156  
  6157   "^DD",200, 200,0,"PT" ,366.013,. 04)
  6158  
  6159   "^DD",200, 200,0,"PT" ,366.023,. 04)
  6160  
  6161   "^DD",200, 200,0,"PT" ,366.033,. 04)
  6162  
  6163   "^DD",200, 200,0,"PT" ,366.141,. 06)
  6164  
  6165   "^DD",200, 200,0,"PT" ,366.141,. 211)
  6166  
  6167   "^DD",200, 200,0,"PT" ,366.141,. 31)
  6168  
  6169   "^DD",200, 200,0,"PT" ,368,200.0 3)
  6170  
  6171   "^DD",200, 200,0,"PT" ,368,200.0 6)
  6172  
  6173   "^DD",200, 200,0,"PT" ,368.0201, .02)
  6174  
  6175   "^DD",200, 200,0,"PT" ,372.01,.0 3)
  6176  
  6177   "^DD",200, 200,0,"PT" ,373,3.11)
  6178  
  6179   "^DD",200, 200,0,"PT" ,373,3.12)
  6180  
  6181   "^DD",200, 200,0,"PT" ,373,6.2)
  6182  
  6183   "^DD",200, 200,0,"PT" ,373,6.21)
  6184  
  6185   "^DD",200, 200,0,"PT" ,375,1.07)
  6186  
  6187   "^DD",200, 200,0,"PT" ,375,1.09)
  6188  
  6189   "^DD",200, 200,0,"PT" ,375,1.17)
  6190  
  6191   "^DD",200, 200,0,"PT" ,375,1.52)
  6192  
  6193   "^DD",200, 200,0,"PT" ,375,3.11)
  6194  
  6195   "^DD",200, 200,0,"PT" ,391.12,.0 2)
  6196  
  6197   "^DD",200, 200,0,"PT" ,391.12,.0 4)
  6198  
  6199   "^DD",200, 200,0,"PT" ,391.31,4)
  6200  
  6201   "^DD",200, 200,0,"PT" ,391.317,. 03)
  6202  
  6203   "^DD",200, 200,0,"PT" ,391.71,.0 9)
  6204  
  6205   "^DD",200, 200,0,"PT" ,391.98,12 )
  6206  
  6207   "^DD",200, 200,0,"PT" ,392,12)
  6208  
  6209   "^DD",200, 200,0,"PT" ,392,41)
  6210  
  6211   "^DD",200, 200,0,"PT" ,392,84)
  6212  
  6213   "^DD",200, 200,0,"PT" ,392.2,5)
  6214  
  6215   "^DD",200, 200,0,"PT" ,392.51,1)
  6216  
  6217   "^DD",200, 200,0,"PT" ,392.7,4)
  6218  
  6219   "^DD",200, 200,0,"PT" ,392.7,6)
  6220  
  6221   "^DD",200, 200,0,"PT" ,392.7,98)
  6222  
  6223   "^DD",200, 200,0,"PT" ,393,.09)
  6224  
  6225   "^DD",200, 200,0,"PT" ,393,.1)
  6226  
  6227   "^DD",200, 200,0,"PT" ,393,.12)
  6228  
  6229   "^DD",200, 200,0,"PT" ,393,.14)
  6230  
  6231   "^DD",200, 200,0,"PT" ,393,10.02 )
  6232  
  6233   "^DD",200, 200,0,"PT" ,393,10.04 )
  6234  
  6235   "^DD",200, 200,0,"PT" ,393,10.06 )
  6236  
  6237   "^DD",200, 200,0,"PT" ,393,10.08 )
  6238  
  6239   "^DD",200, 200,0,"PT" ,394.6171, .01)
  6240  
  6241   "^DD",200, 200,0,"PT" ,394.82,10 )
  6242  
  6243   "^DD",200, 200,0,"PT" ,394.83,.0 2)
  6244  
  6245   "^DD",200, 200,0,"PT" ,394.831,1 0)
  6246  
  6247   "^DD",200, 200,0,"PT" ,394.84,.0 3)
  6248  
  6249   "^DD",200, 200,0,"PT" ,394.841,. 02)
  6250  
  6251   "^DD",200, 200,0,"PT" ,394.87,.0 2)
  6252  
  6253   "^DD",200, 200,0,"PT" ,395.51,.0 1)
  6254  
  6255   "^DD",200, 200,0,"PT" ,395.7,1)
  6256  
  6257   "^DD",200, 200,0,"PT" ,395.7,5)
  6258  
  6259   "^DD",200, 200,0,"PT" ,396,6.84)
  6260  
  6261   "^DD",200, 200,0,"PT" ,396.17,2)
  6262  
  6263   "^DD",200, 200,0,"PT" ,396.17,10 )
  6264  
  6265   "^DD",200, 200,0,"PT" ,396.1714, 1)
  6266  
  6267   "^DD",200, 200,0,"PT" ,396.2,5)
  6268  
  6269   "^DD",200, 200,0,"PT" ,396.3,3)
  6270  
  6271   "^DD",200, 200,0,"PT" ,396.3,14)
  6272  
  6273   "^DD",200, 200,0,"PT" ,396.3,16)
  6274  
  6275   "^DD",200, 200,0,"PT" ,396.3,20)
  6276  
  6277   "^DD",200, 200,0,"PT" ,396.3,23. 4)
  6278  
  6279   "^DD",200, 200,0,"PT" ,396.3,23. 6)
  6280  
  6281   "^DD",200, 200,0,"PT" ,396.327,2 .3)
  6282  
  6283   "^DD",200, 200,0,"PT" ,396.4,51)
  6284  
  6285   "^DD",200, 200,0,"PT" ,396.9,11)
  6286  
  6287   "^DD",200, 200,0,"PT" ,399,2)
  6288  
  6289   "^DD",200, 200,0,"PT" ,399,5)
  6290  
  6291   "^DD",200, 200,0,"PT" ,399,8)
  6292  
  6293   "^DD",200, 200,0,"PT" ,399,11)
  6294  
  6295   "^DD",200, 200,0,"PT" ,399,13)
  6296  
  6297   "^DD",200, 200,0,"PT" ,399,15)
  6298  
  6299   "^DD",200, 200,0,"PT" ,399,18)
  6300  
  6301   "^DD",200, 200,0,"PT" ,399,32)
  6302  
  6303   "^DD",200, 200,0,"PT" ,399,37)
  6304  
  6305   "^DD",200, 200,0,"PT" ,399,475)
  6306  
  6307   "^DD",200, 200,0,"PT" ,399,477)
  6308  
  6309   "^DD",200, 200,0,"PT" ,399,479)
  6310  
  6311   "^DD",200, 200,0,"PT" ,399.0222, .02)
  6312  
  6313   "^DD",200, 200,0,"PT" ,399.0304, 18)
  6314  
  6315   "^DD",200, 200,0,"PT" ,399.0404, .02)
  6316  
  6317   "^DD",200, 200,0,"PT" ,399.046,. 02)
  6318  
  6319   "^DD",200, 200,0,"PT" ,399.077,. 02)
  6320  
  6321   "^DD",200, 200,0,"PT" ,399.078,. 02)
  6322  
  6323   "^DD",200, 200,0,"PT" ,403.35,.0 1)
  6324  
  6325   "^DD",200, 200,0,"PT" ,403.5,7)
  6326  
  6327   "^DD",200, 200,0,"PT" ,403.54,.0 1)
  6328  
  6329   "^DD",200, 200,0,"PT" ,403.56,7)
  6330  
  6331   "^DD",200, 200,0,"PT" ,403.56,20 2)
  6332  
  6333   "^DD",200, 200,0,"PT" ,404.42,.1 1)
  6334  
  6335   "^DD",200, 200,0,"PT" ,404.42,.1 3)
  6336  
  6337   "^DD",200, 200,0,"PT" ,404.43,.0 6)
  6338  
  6339   "^DD",200, 200,0,"PT" ,404.43,.0 8)
  6340  
  6341   "^DD",200, 200,0,"PT" ,404.43,.1 6)
  6342  
  6343   "^DD",200, 200,0,"PT" ,404.471,. 08)
  6344  
  6345   "^DD",200, 200,0,"PT" ,404.48,.0 5)
  6346  
  6347   "^DD",200, 200,0,"PT" ,404.52,.0 3)
  6348  
  6349   "^DD",200, 200,0,"PT" ,404.52,.0 7)
  6350  
  6351   "^DD",200, 200,0,"PT" ,404.521,. 03)
  6352  
  6353   "^DD",200, 200,0,"PT" ,404.53,.0 7)
  6354  
  6355   "^DD",200, 200,0,"PT" ,404.56,.0 2)
  6356  
  6357   "^DD",200, 200,0,"PT" ,404.9101, .03)
  6358  
  6359   "^DD",200, 200,0,"PT" ,404.9101, .04)
  6360  
  6361   "^DD",200, 200,0,"PT" ,404.91709 ,.04)
  6362  
  6363   "^DD",200, 200,0,"PT" ,404.95,.0 2)
  6364  
  6365   "^DD",200, 200,0,"PT" ,404.9503, .01)
  6366  
  6367   "^DD",200, 200,0,"PT" ,404.9825, .06)
  6368  
  6369   "^DD",200, 200,0,"PT" ,405,.08)
  6370  
  6371   "^DD",200, 200,0,"PT" ,405,.19)
  6372  
  6373   "^DD",200, 200,0,"PT" ,405,43)
  6374  
  6375   "^DD",200, 200,0,"PT" ,405,100)
  6376  
  6377   "^DD",200, 200,0,"PT" ,405,102)
  6378  
  6379   "^DD",200, 200,0,"PT" ,408,10)
  6380  
  6381   "^DD",200, 200,0,"PT" ,408.21,10 1)
  6382  
  6383   "^DD",200, 200,0,"PT" ,408.21,10 3)
  6384  
  6385   "^DD",200, 200,0,"PT" ,408.31,.0 6)
  6386  
  6387   "^DD",200, 200,0,"PT" ,408.31,.0 8)
  6388  
  6389   "^DD",200, 200,0,"PT" ,408.31,.2 2)
  6390  
  6391   "^DD",200, 200,0,"PT" ,408.41,.0 7)
  6392  
  6393   "^DD",200, 200,0,"PT" ,409.3,9)
  6394  
  6395   "^DD",200, 200,0,"PT" ,409.3,12)
  6396  
  6397   "^DD",200, 200,0,"PT" ,409.3,13. 7)
  6398  
  6399   "^DD",200, 200,0,"PT" ,409.3,17)
  6400  
  6401   "^DD",200, 200,0,"PT" ,409.3,20)
  6402  
  6403   "^DD",200, 200,0,"PT" ,409.3,28)
  6404  
  6405   "^DD",200, 200,0,"PT" ,409.311,2 )
  6406  
  6407   "^DD",200, 200,0,"PT" ,409.311,4 )
  6408  
  6409   "^DD",200, 200,0,"PT" ,409.32,2)
  6410  
  6411   "^DD",200, 200,0,"PT" ,409.32,4)
  6412  
  6413   "^DD",200, 200,0,"PT" ,409.344,2 )
  6414  
  6415   "^DD",200, 200,0,"PT" ,409.345,1 )
  6416  
  6417   "^DD",200, 200,0,"PT" ,409.35,4)
  6418  
  6419   "^DD",200, 200,0,"PT" ,409.44,.0 1)
  6420  
  6421   "^DD",200, 200,0,"PT" ,409.48,.0 3)
  6422  
  6423   "^DD",200, 200,0,"PT" ,409.48,.0 8)
  6424  
  6425   "^DD",200, 200,0,"PT" ,409.481,. 03)
  6426  
  6427   "^DD",200, 200,0,"PT" ,409.51,2)
  6428  
  6429   "^DD",200, 200,0,"PT" ,409.65,.0 4)
  6430  
  6431   "^DD",200, 200,0,"PT" ,409.68,10 1)
  6432  
  6433   "^DD",200, 200,0,"PT" ,409.68,10 3)
  6434  
  6435   "^DD",200, 200,0,"PT" ,409.73,.0 7)
  6436  
  6437   "^DD",200, 200,0,"PT" ,409.831,. 01)
  6438  
  6439   "^DD",200, 200,0,"PT" ,409.831,. 012)
  6440  
  6441   "^DD",200, 200,0,"PT" ,409.831,. 016)
  6442  
  6443   "^DD",200, 200,0,"PT" ,409.831,. 022)
  6444  
  6445   "^DD",200, 200,0,"PT" ,409.831,. 026)
  6446  
  6447   "^DD",200, 200,0,"PT" ,409.833,. 02)
  6448  
  6449   "^DD",200, 200,0,"PT" ,409.84,.0 8)
  6450  
  6451   "^DD",200, 200,0,"PT" ,409.84,.1 02)
  6452  
  6453   "^DD",200, 200,0,"PT" ,409.84,.1 21)
  6454  
  6455   "^DD",200, 200,0,"PT" ,409.84,.1 6)
  6456  
  6457   "^DD",200, 200,0,"PT" ,409.8451, 3)
  6458  
  6459   "^DD",200, 200,0,"PT" ,409.8451, 5)
  6460  
  6461   "^DD",200, 200,0,"PT" ,409.85,9)
  6462  
  6463   "^DD",200, 200,0,"PT" ,409.85,12 )
  6464  
  6465   "^DD",200, 200,0,"PT" ,409.85,13 .7)
  6466  
  6467   "^DD",200, 200,0,"PT" ,409.85,20 )
  6468  
  6469   "^DD",200, 200,0,"PT" ,409.8544, 2)
  6470  
  6471   "^DD",200, 200,0,"PT" ,409.8545, 1)
  6472  
  6473   "^DD",200, 200,0,"PT" ,409.91,1)
  6474  
  6475   "^DD",200, 200,0,"PT" ,409.91,3)
  6476  
  6477   "^DD",200, 200,0,"PT" ,410,29)
  6478  
  6479   "^DD",200, 200,0,"PT" ,410,39)
  6480  
  6481   "^DD",200, 200,0,"PT" ,410,40)
  6482  
  6483   "^DD",200, 200,0,"PT" ,410,42)
  6484  
  6485   "^DD",200, 200,0,"PT" ,410,44.7)
  6486  
  6487   "^DD",200, 200,0,"PT" ,410,53)
  6488  
  6489   "^DD",200, 200,0,"PT" ,410,62)
  6490  
  6491   "^DD",200, 200,0,"PT" ,410,68)
  6492  
  6493   "^DD",200, 200,0,"PT" ,410,104)
  6494  
  6495   "^DD",200, 200,0,"PT" ,411,46)
  6496  
  6497   "^DD",200, 200,0,"PT" ,411.045,. 01)
  6498  
  6499   "^DD",200, 200,0,"PT" ,411.05,.0 1)
  6500  
  6501   "^DD",200, 200,0,"PT" ,411.3,2)
  6502  
  6503   "^DD",200, 200,0,"PT" ,412,.01)
  6504  
  6505   "^DD",200, 200,0,"PT" ,413,1)
  6506  
  6507   "^DD",200, 200,0,"PT" ,413,5)
  6508  
  6509   "^DD",200, 200,0,"PT" ,413,9.1)
  6510  
  6511   "^DD",200, 200,0,"PT" ,413,30)
  6512  
  6513   "^DD",200, 200,0,"PT" ,413,67)
  6514  
  6515   "^DD",200, 200,0,"PT" ,413.1,1)
  6516  
  6517   "^DD",200, 200,0,"PT" ,413.1,5)
  6518  
  6519   "^DD",200, 200,0,"PT" ,413.1,16)
  6520  
  6521   "^DD",200, 200,0,"PT" ,413.2,.01 )
  6522  
  6523   "^DD",200, 200,0,"PT" ,413.3,.01 )
  6524  
  6525   "^DD",200, 200,0,"PT" ,414.02,3)
  6526  
  6527   "^DD",200, 200,0,"PT" ,414.02,9)
  6528  
  6529   "^DD",200, 200,0,"PT" ,414.021,1 )
  6530  
  6531   "^DD",200, 200,0,"PT" ,414.061,3 )
  6532  
  6533   "^DD",200, 200,0,"PT" ,420.01,23 )
  6534  
  6535   "^DD",200, 200,0,"PT" ,420.02,.0 1)
  6536  
  6537   "^DD",200, 200,0,"PT" ,420.05,.0 1)
  6538  
  6539   "^DD",200, 200,0,"PT" ,420.1,.6)
  6540  
  6541   "^DD",200, 200,0,"PT" ,420.2,.6)
  6542  
  6543   "^DD",200, 200,0,"PT" ,420.9999, 4)
  6544  
  6545   "^DD",200, 200,0,"PT" ,421,12)
  6546  
  6547   "^DD",200, 200,0,"PT" ,421.1,6)
  6548  
  6549   "^DD",200, 200,0,"PT" ,421.2,.8)
  6550  
  6551   "^DD",200, 200,0,"PT" ,421.2,5)
  6552  
  6553   "^DD",200, 200,0,"PT" ,421.2,8)
  6554  
  6555   "^DD",200, 200,0,"PT" ,421.4,2)
  6556  
  6557   "^DD",200, 200,0,"PT" ,421.5,54. 5)
  6558  
  6559   "^DD",200, 200,0,"PT" ,421.5,59)
  6560  
  6561   "^DD",200, 200,0,"PT" ,421.5,60)
  6562  
  6563   "^DD",200, 200,0,"PT" ,421.5,66)
  6564  
  6565   "^DD",200, 200,0,"PT" ,421.51,2)
  6566  
  6567   "^DD",200, 200,0,"PT" ,423,999)
  6568  
  6569   "^DD",200, 200,0,"PT" ,423,999.2 )
  6570  
  6571   "^DD",200, 200,0,"PT" ,423.9001, .01)
  6572  
  6573   "^DD",200, 200,0,"PT" ,424,.08)
  6574  
  6575   "^DD",200, 200,0,"PT" ,424,.14)
  6576  
  6577   "^DD",200, 200,0,"PT" ,424.1,.05 )
  6578  
  6579   "^DD",200, 200,0,"PT" ,424.1,.1)
  6580  
  6581   "^DD",200, 200,0,"PT" ,430,17)
  6582  
  6583   "^DD",200, 200,0,"PT" ,430,32)
  6584  
  6585   "^DD",200, 200,0,"PT" ,430,34)
  6586  
  6587   "^DD",200, 200,0,"PT" ,430,79.21 )
  6588  
  6589   "^DD",200, 200,0,"PT" ,430,90)
  6590  
  6591   "^DD",200, 200,0,"PT" ,430,94)
  6592  
  6593   "^DD",200, 200,0,"PT" ,430,97)
  6594  
  6595   "^DD",200, 200,0,"PT" ,430,111)
  6596  
  6597   "^DD",200, 200,0,"PT" ,430,126)
  6598  
  6599   "^DD",200, 200,0,"PT" ,433,42)
  6600  
  6601   "^DD",200, 200,0,"PT" ,435,.02)
  6602  
  6603   "^DD",200, 200,0,"PT" ,435,.07)
  6604  
  6605   "^DD",200, 200,0,"PT" ,435,.11)
  6606  
  6607   "^DD",200, 200,0,"PT" ,436.12,.0 2)
  6608  
  6609   "^DD",200, 200,0,"PT" ,440,31)
  6610  
  6611   "^DD",200, 200,0,"PT" ,440,33)
  6612  
  6613   "^DD",200, 200,0,"PT" ,440.3,31)
  6614  
  6615   "^DD",200, 200,0,"PT" ,440.3,33)
  6616  
  6617   "^DD",200, 200,0,"PT" ,440.5,7)
  6618  
  6619   "^DD",200, 200,0,"PT" ,440.5,8)
  6620  
  6621   "^DD",200, 200,0,"PT" ,440.5,9)
  6622  
  6623   "^DD",200, 200,0,"PT" ,440.512,. 01)
  6624  
  6625   "^DD",200, 200,0,"PT" ,440.6,16)
  6626  
  6627   "^DD",200, 200,0,"PT" ,440.6,27)
  6628  
  6629   "^DD",200, 200,0,"PT" ,440.6,45)
  6630  
  6631   "^DD",200, 200,0,"PT" ,441,15)
  6632  
  6633   "^DD",200, 200,0,"PT" ,441,18)
  6634  
  6635   "^DD",200, 200,0,"PT" ,442,16)
  6636  
  6637   "^DD",200, 200,0,"PT" ,442,19)
  6638  
  6639   "^DD",200, 200,0,"PT" ,442,56)
  6640  
  6641   "^DD",200, 200,0,"PT" ,442,57)
  6642  
  6643   "^DD",200, 200,0,"PT" ,442,61)
  6644  
  6645   "^DD",200, 200,0,"PT" ,442,104)
  6646  
  6647   "^DD",200, 200,0,"PT" ,442,113)
  6648  
  6649   "^DD",200, 200,0,"PT" ,442.07,6)
  6650  
  6651   "^DD",200, 200,0,"PT" ,442.07,10 )
  6652  
  6653   "^DD",200, 200,0,"PT" ,442.09,1)
  6654  
  6655   "^DD",200, 200,0,"PT" ,442.11,6)
  6656  
  6657   "^DD",200, 200,0,"PT" ,442.11,14 )
  6658  
  6659   "^DD",200, 200,0,"PT" ,442.11,17 )
  6660  
  6661   "^DD",200, 200,0,"PT" ,442.11,19 .3)
  6662  
  6663   "^DD",200, 200,0,"PT" ,442.14,2)
  6664  
  6665   "^DD",200, 200,0,"PT" ,442.14,6)
  6666  
  6667   "^DD",200, 200,0,"PT" ,442.714,6 )
  6668  
  6669   "^DD",200, 200,0,"PT" ,442.9,2)
  6670  
  6671   "^DD",200, 200,0,"PT" ,443,2)
  6672  
  6673   "^DD",200, 200,0,"PT" ,443,6)
  6674  
  6675   "^DD",200, 200,0,"PT" ,443.6,16)
  6676  
  6677   "^DD",200, 200,0,"PT" ,443.6,19)
  6678  
  6679   "^DD",200, 200,0,"PT" ,443.6,56)
  6680  
  6681   "^DD",200, 200,0,"PT" ,443.6,57)
  6682  
  6683   "^DD",200, 200,0,"PT" ,443.6,61)
  6684  
  6685   "^DD",200, 200,0,"PT" ,443.67,6)
  6686  
  6687   "^DD",200, 200,0,"PT" ,443.67,10 )
  6688  
  6689   "^DD",200, 200,0,"PT" ,443.6714, 6)
  6690  
  6691   "^DD",200, 200,0,"PT" ,443.75,5. 5)
  6692  
  6693   "^DD",200, 200,0,"PT" ,443.76,2)
  6694  
  6695   "^DD",200, 200,0,"PT" ,444,3)
  6696  
  6697   "^DD",200, 200,0,"PT" ,444,10)
  6698  
  6699   "^DD",200, 200,0,"PT" ,444,20.7)
  6700  
  6701   "^DD",200, 200,0,"PT" ,444,25)
  6702  
  6703   "^DD",200, 200,0,"PT" ,444.021,1 3)
  6704  
  6705   "^DD",200, 200,0,"PT" ,444.024,1 3)
  6706  
  6707   "^DD",200, 200,0,"PT" ,444.4,.01 )
  6708  
  6709   "^DD",200, 200,0,"PT" ,445,19.5)
  6710  
  6711   "^DD",200, 200,0,"PT" ,445,24)
  6712  
  6713   "^DD",200, 200,0,"PT" ,445.026,. 01)
  6714  
  6715   "^DD",200, 200,0,"PT" ,445.027,. 01)
  6716  
  6717   "^DD",200, 200,0,"PT" ,445.04,.0 1)
  6718  
  6719   "^DD",200, 200,0,"PT" ,445.13,1)
  6720  
  6721   "^DD",200, 200,0,"PT" ,445.2,8.5 )
  6722  
  6723   "^DD",200, 200,0,"PT" ,445.2,21)
  6724  
  6725   "^DD",200, 200,0,"PT" ,445.3,4)
  6726  
  6727   "^DD",200, 200,0,"PT" ,445.7,3)
  6728  
  6729   "^DD",200, 200,0,"PT" ,445.7,5)
  6730  
  6731   "^DD",200, 200,0,"PT" ,445.8,3)
  6732  
  6733   "^DD",200, 200,0,"PT" ,445.8,5)
  6734  
  6735   "^DD",200, 200,0,"PT" ,446.1,130 .04)
  6736  
  6737   "^DD",200, 200,0,"PT" ,446.4,.1)
  6738  
  6739   "^DD",200, 200,0,"PT" ,446.42,.0 2)
  6740  
  6741   "^DD",200, 200,0,"PT" ,447,1)
  6742  
  6743   "^DD",200, 200,0,"PT" ,450,700)
  6744  
  6745   "^DD",200, 200,0,"PT" ,450,755)
  6746  
  6747   "^DD",200, 200,0,"PT" ,451.06,1)
  6748  
  6749   "^DD",200, 200,0,"PT" ,451.09,2)
  6750  
  6751   "^DD",200, 200,0,"PT" ,451.999,1 )
  6752  
  6753   "^DD",200, 200,0,"PT" ,452,.01)
  6754  
  6755   "^DD",200, 200,0,"PT" ,452.4,3)
  6756  
  6757   "^DD",200, 200,0,"PT" ,452.8894, .01)
  6758  
  6759   "^DD",200, 200,0,"PT" ,453,747.4 4)
  6760  
  6761   "^DD",200, 200,0,"PT" ,455.51,.0 1)
  6762  
  6763   "^DD",200, 200,0,"PT" ,455.511,. 01)
  6764  
  6765   "^DD",200, 200,0,"PT" ,455.512,. 01)
  6766  
  6767   "^DD",200, 200,0,"PT" ,455.52,.0 1)
  6768  
  6769   "^DD",200, 200,0,"PT" ,455.531,. 01)
  6770  
  6771   "^DD",200, 200,0,"PT" ,458,2)
  6772  
  6773   "^DD",200, 200,0,"PT" ,458.01,2)
  6774  
  6775   "^DD",200, 200,0,"PT" ,458.01,34 )
  6776  
  6777   "^DD",200, 200,0,"PT" ,458.01,36 )
  6778  
  6779   "^DD",200, 200,0,"PT" ,458.02,5)
  6780  
  6781   "^DD",200, 200,0,"PT" ,458.02,10 )
  6782  
  6783   "^DD",200, 200,0,"PT" ,458.02,10 2)
  6784  
  6785   "^DD",200, 200,0,"PT" ,458.1,9)
  6786  
  6787   "^DD",200, 200,0,"PT" ,458.1,11)
  6788  
  6789   "^DD",200, 200,0,"PT" ,458.1101, 2)
  6790  
  6791   "^DD",200, 200,0,"PT" ,458.1101, 5)
  6792  
  6793   "^DD",200, 200,0,"PT" ,458.1101, 7)
  6794  
  6795   "^DD",200, 200,0,"PT" ,458.1101, 9)
  6796  
  6797   "^DD",200, 200,0,"PT" ,458.1105, 2)
  6798  
  6799   "^DD",200, 200,0,"PT" ,458.2,15)
  6800  
  6801   "^DD",200, 200,0,"PT" ,458.2,17)
  6802  
  6803   "^DD",200, 200,0,"PT" ,458.2,21)
  6804  
  6805   "^DD",200, 200,0,"PT" ,458.3,9)
  6806  
  6807   "^DD",200, 200,0,"PT" ,458.3,11)
  6808  
  6809   "^DD",200, 200,0,"PT" ,458.5,6)
  6810  
  6811   "^DD",200, 200,0,"PT" ,458.6,5)
  6812  
  6813   "^DD",200, 200,0,"PT" ,458.7,6)
  6814  
  6815   "^DD",200, 200,0,"PT" ,458.7,19)
  6816  
  6817   "^DD",200, 200,0,"PT" ,458.7,23)
  6818  
  6819   "^DD",200, 200,0,"PT" ,458.83,1)
  6820  
  6821   "^DD",200, 200,0,"PT" ,470,10.7)
  6822  
  6823   "^DD",200, 200,0,"PT" ,470,69)
  6824  
  6825   "^DD",200, 200,0,"PT" ,470.1,13)
  6826  
  6827   "^DD",200, 200,0,"PT" ,550.04,1)
  6828  
  6829   "^DD",200, 200,0,"PT" ,550.07,5)
  6830  
  6831   "^DD",200, 200,0,"PT" ,550.09,5)
  6832  
  6833   "^DD",200, 200,0,"PT" ,550.2,4)
  6834  
  6835   "^DD",200, 200,0,"PT" ,600.71,3)
  6836  
  6837   "^DD",200, 200,0,"PT" ,601,37)
  6838  
  6839   "^DD",200, 200,0,"PT" ,601.22,2)
  6840  
  6841   "^DD",200, 200,0,"PT" ,601.22,3)
  6842  
  6843   "^DD",200, 200,0,"PT" ,601.2213, 2)
  6844  
  6845   "^DD",200, 200,0,"PT" ,601.2213, 3)
  6846  
  6847   "^DD",200, 200,0,"PT" ,601.2213, 6)
  6848  
  6849   "^DD",200, 200,0,"PT" ,601.2213, 7)
  6850  
  6851   "^DD",200, 200,0,"PT" ,601.41,16 )
  6852  
  6853   "^DD",200, 200,0,"PT" ,601.781,1 )
  6854  
  6855   "^DD",200, 200,0,"PT" ,601.84,5)
  6856  
  6857   "^DD",200, 200,0,"PT" ,601.84,6)
  6858  
  6859   "^DD",200, 200,0,"PT" ,601.94,8)
  6860  
  6861   "^DD",200, 200,0,"PT" ,604,.09)
  6862  
  6863   "^DD",200, 200,0,"PT" ,604,.14)
  6864  
  6865   "^DD",200, 200,0,"PT" ,604,.52)
  6866  
  6867   "^DD",200, 200,0,"PT" ,604,.71)
  6868  
  6869   "^DD",200, 200,0,"PT" ,604,.81)
  6870  
  6871   "^DD",200, 200,0,"PT" ,604.81,.0 1)
  6872  
  6873   "^DD",200, 200,0,"PT" ,615.01,5)
  6874  
  6875   "^DD",200, 200,0,"PT" ,615.02,2)
  6876  
  6877   "^DD",200, 200,0,"PT" ,615.03,4)
  6878  
  6879   "^DD",200, 200,0,"PT" ,615.2,.05 )
  6880  
  6881   "^DD",200, 200,0,"PT" ,615.2,4)
  6882  
  6883   "^DD",200, 200,0,"PT" ,615.2,25)
  6884  
  6885   "^DD",200, 200,0,"PT" ,615.2,40)
  6886  
  6887   "^DD",200, 200,0,"PT" ,615.2,41)
  6888  
  6889   "^DD",200, 200,0,"PT" ,615.2,43)
  6890  
  6891   "^DD",200, 200,0,"PT" ,615.2,50)
  6892  
  6893   "^DD",200, 200,0,"PT" ,615.2,53)
  6894  
  6895   "^DD",200, 200,0,"PT" ,615.3,1)
  6896  
  6897   "^DD",200, 200,0,"PT" ,615.3,2)
  6898  
  6899   "^DD",200, 200,0,"PT" ,617.01,2)
  6900  
  6901   "^DD",200, 200,0,"PT" ,618.04,2)
  6902  
  6903   "^DD",200, 200,0,"PT" ,618.2,1)
  6904  
  6905   "^DD",200, 200,0,"PT" ,618.2,2)
  6906  
  6907   "^DD",200, 200,0,"PT" ,618.2,3)
  6908  
  6909   "^DD",200, 200,0,"PT" ,618.2,4)
  6910  
  6911   "^DD",200, 200,0,"PT" ,618.2,5)
  6912  
  6913   "^DD",200, 200,0,"PT" ,618.2,6)
  6914  
  6915   "^DD",200, 200,0,"PT" ,618.2,7)
  6916  
  6917   "^DD",200, 200,0,"PT" ,618.2,8)
  6918  
  6919   "^DD",200, 200,0,"PT" ,618.4,4)
  6920  
  6921   "^DD",200, 200,0,"PT" ,618.4,5)
  6922  
  6923   "^DD",200, 200,0,"PT" ,618.4,6)
  6924  
  6925   "^DD",200, 200,0,"PT" ,618.418,1 )
  6926  
  6927   "^DD",200, 200,0,"PT" ,618.419,2 )
  6928  
  6929   "^DD",200, 200,0,"PT" ,627.8,.04 )
  6930  
  6931   "^DD",200, 200,0,"PT" ,627.8,.05 )
  6932  
  6933   "^DD",200, 200,0,"PT" ,631,80)
  6934  
  6935   "^DD",200, 200,0,"PT" ,631,82)
  6936  
  6937   "^DD",200, 200,0,"PT" ,631.4,1)
  6938  
  6939   "^DD",200, 200,0,"PT" ,632,12)
  6940  
  6941   "^DD",200, 200,0,"PT" ,633.2,32)
  6942  
  6943   "^DD",200, 200,0,"PT" ,633.213,1 )
  6944  
  6945   "^DD",200, 200,0,"PT" ,633.214,1 )
  6946  
  6947   "^DD",200, 200,0,"PT" ,633.215,1 )
  6948  
  6949   "^DD",200, 200,0,"PT" ,633.216,1 )
  6950  
  6951   "^DD",200, 200,0,"PT" ,650,2)
  6952  
  6953   "^DD",200, 200,0,"PT" ,650.121,. 01)
  6954  
  6955   "^DD",200, 200,0,"PT" ,652,3)
  6956  
  6957   "^DD",200, 200,0,"PT" ,655.2,.03 )
  6958  
  6959   "^DD",200, 200,0,"PT" ,655.2,.04 )
  6960  
  6961   "^DD",200, 200,0,"PT" ,655.2,.05 )
  6962  
  6963   "^DD",200, 200,0,"PT" ,655.218,. 01)
  6964  
  6965   "^DD",200, 200,0,"PT" ,655.38,1)
  6966  
  6967   "^DD",200, 200,0,"PT" ,660,8.6)
  6968  
  6969   "^DD",200, 200,0,"PT" ,660,27)
  6970  
  6971   "^DD",200, 200,0,"PT" ,660,35)
  6972  
  6973   "^DD",200, 200,0,"PT" ,660,105)
  6974  
  6975   "^DD",200, 200,0,"PT" ,661.2,7)
  6976  
  6977   "^DD",200, 200,0,"PT" ,661.5,6)
  6978  
  6979   "^DD",200, 200,0,"PT" ,661.6,9)
  6980  
  6981   "^DD",200, 200,0,"PT" ,664,3.2)
  6982  
  6983   "^DD",200, 200,0,"PT" ,664,8.5)
  6984  
  6985   "^DD",200, 200,0,"PT" ,664,8.6)
  6986  
  6987   "^DD",200, 200,0,"PT" ,664,10)
  6988  
  6989   "^DD",200, 200,0,"PT" ,664,23)
  6990  
  6991   "^DD",200, 200,0,"PT" ,664.1,7)
  6992  
  6993   "^DD",200, 200,0,"PT" ,664.1,9)
  6994  
  6995   "^DD",200, 200,0,"PT" ,664.1,12. 1)
  6996  
  6997   "^DD",200, 200,0,"PT" ,664.1,13)
  6998  
  6999   "^DD",200, 200,0,"PT" ,664.1,14)
  7000  
  7001   "^DD",200, 200,0,"PT" ,664.1,15)
  7002  
  7003   "^DD",200, 200,0,"PT" ,664.1,21)
  7004  
  7005   "^DD",200, 200,0,"PT" ,664.1,22)
  7006  
  7007   "^DD",200, 200,0,"PT" ,664.1,27)
  7008  
  7009   "^DD",200, 200,0,"PT" ,664.129,3 )
  7010  
  7011   "^DD",200, 200,0,"PT" ,664.129,5 )
  7012  
  7013   "^DD",200, 200,0,"PT" ,664.2,9)
  7014  
  7015   "^DD",200, 200,0,"PT" ,664.2,11)
  7016  
  7017   "^DD",200, 200,0,"PT" ,664.33,.0 1)
  7018  
  7019   "^DD",200, 200,0,"PT" ,665,19.7)
  7020  
  7021   "^DD",200, 200,0,"PT" ,665.01,7)
  7022  
  7023   "^DD",200, 200,0,"PT" ,665.02,6)
  7024  
  7025   "^DD",200, 200,0,"PT" ,665.1,3)
  7026  
  7027   "^DD",200, 200,0,"PT" ,665.193,1 01)
  7028  
  7029   "^DD",200, 200,0,"PT" ,665.4,4)
  7030  
  7031   "^DD",200, 200,0,"PT" ,665.72319 1,102)
  7032  
  7033   "^DD",200, 200,0,"PT" ,665.7232, 4)
  7034  
  7035   "^DD",200, 200,0,"PT" ,667.3,13)
  7036  
  7037   "^DD",200, 200,0,"PT" ,668,6)
  7038  
  7039   "^DD",200, 200,0,"PT" ,668,8)
  7040  
  7041   "^DD",200, 200,0,"PT" ,668,13)
  7042  
  7043   "^DD",200, 200,0,"PT" ,668,16)
  7044  
  7045   "^DD",200, 200,0,"PT" ,668,17)
  7046  
  7047   "^DD",200, 200,0,"PT" ,668,24)
  7048  
  7049   "^DD",200, 200,0,"PT" ,669.9003, .01)
  7050  
  7051   "^DD",200, 200,0,"PT" ,680.5,13)
  7052  
  7053   "^DD",200, 200,0,"PT" ,681,3)
  7054  
  7055   "^DD",200, 200,0,"PT" ,682,1.5)
  7056  
  7057   "^DD",200, 200,0,"PT" ,682.04,2)
  7058  
  7059   "^DD",200, 200,0,"PT" ,682.04,6)
  7060  
  7061   "^DD",200, 200,0,"PT" ,682.1,37)
  7062  
  7063   "^DD",200, 200,0,"PT" ,686.11,1)
  7064  
  7065   "^DD",200, 200,0,"PT" ,686.112,. 01)
  7066  
  7067   "^DD",200, 200,0,"PT" ,686.13104 ,1)
  7068  
  7069   "^DD",200, 200,0,"PT" ,691,39)
  7070  
  7071   "^DD",200, 200,0,"PT" ,691,43)
  7072  
  7073   "^DD",200, 200,0,"PT" ,691,701)
  7074  
  7075   "^DD",200, 200,0,"PT" ,691,1500)
  7076  
  7077   "^DD",200, 200,0,"PT" ,691,1503)
  7078  
  7079   "^DD",200, 200,0,"PT" ,691,1512)
  7080  
  7081   "^DD",200, 200,0,"PT" ,691.1,62)
  7082  
  7083   "^DD",200, 200,0,"PT" ,691.1,63)
  7084  
  7085   "^DD",200, 200,0,"PT" ,691.1,64)
  7086  
  7087   "^DD",200, 200,0,"PT" ,691.1,65)
  7088  
  7089   "^DD",200, 200,0,"PT" ,691.1,701 )
  7090  
  7091   "^DD",200, 200,0,"PT" ,691.1,150 0)
  7092  
  7093   "^DD",200, 200,0,"PT" ,691.1,150 3)
  7094  
  7095   "^DD",200, 200,0,"PT" ,691.1,151 2)
  7096  
  7097   "^DD",200, 200,0,"PT" ,691.5,12)
  7098  
  7099   "^DD",200, 200,0,"PT" ,691.5,701 )
  7100  
  7101   "^DD",200, 200,0,"PT" ,691.5,150 0)
  7102  
  7103   "^DD",200, 200,0,"PT" ,691.5,150 3)
  7104  
  7105   "^DD",200, 200,0,"PT" ,691.5,151 2)
  7106  
  7107   "^DD",200, 200,0,"PT" ,691.6,4)
  7108  
  7109   "^DD",200, 200,0,"PT" ,691.6,6)
  7110  
  7111   "^DD",200, 200,0,"PT" ,691.6,10)
  7112  
  7113   "^DD",200, 200,0,"PT" ,691.6,12)
  7114  
  7115   "^DD",200, 200,0,"PT" ,691.6,14)
  7116  
  7117   "^DD",200, 200,0,"PT" ,691.6,701 )
  7118  
  7119   "^DD",200, 200,0,"PT" ,691.6,150 0)
  7120  
  7121   "^DD",200, 200,0,"PT" ,691.6,150 3)
  7122  
  7123   "^DD",200, 200,0,"PT" ,691.6,151 2)
  7124  
  7125   "^DD",200, 200,0,"PT" ,691.7,57)
  7126  
  7127   "^DD",200, 200,0,"PT" ,691.7,58)
  7128  
  7129   "^DD",200, 200,0,"PT" ,691.7,701 )
  7130  
  7131   "^DD",200, 200,0,"PT" ,691.7,150 0)
  7132  
  7133   "^DD",200, 200,0,"PT" ,691.7,150 3)
  7134  
  7135   "^DD",200, 200,0,"PT" ,691.7,151 2)
  7136  
  7137   "^DD",200, 200,0,"PT" ,691.8,16)
  7138  
  7139   "^DD",200, 200,0,"PT" ,691.8,17)
  7140  
  7141   "^DD",200, 200,0,"PT" ,691.8,19)
  7142  
  7143   "^DD",200, 200,0,"PT" ,691.8,20)
  7144  
  7145   "^DD",200, 200,0,"PT" ,691.8,24)
  7146  
  7147   "^DD",200, 200,0,"PT" ,691.8,25)
  7148  
  7149   "^DD",200, 200,0,"PT" ,691.8,701 )
  7150  
  7151   "^DD",200, 200,0,"PT" ,691.8,150 0)
  7152  
  7153   "^DD",200, 200,0,"PT" ,691.8,150 3)
  7154  
  7155   "^DD",200, 200,0,"PT" ,691.8,151 2)
  7156  
  7157   "^DD",200, 200,0,"PT" ,691.9,24)
  7158  
  7159   "^DD",200, 200,0,"PT" ,691.9,701 )
  7160  
  7161   "^DD",200, 200,0,"PT" ,692,21)
  7162  
  7163   "^DD",200, 200,0,"PT" ,692,701)
  7164  
  7165   "^DD",200, 200,0,"PT" ,694,50)
  7166  
  7167   "^DD",200, 200,0,"PT" ,694,51)
  7168  
  7169   "^DD",200, 200,0,"PT" ,694,701)
  7170  
  7171   "^DD",200, 200,0,"PT" ,694,1500)
  7172  
  7173   "^DD",200, 200,0,"PT" ,694,1503)
  7174  
  7175   "^DD",200, 200,0,"PT" ,694,1512)
  7176  
  7177   "^DD",200, 200,0,"PT" ,694.8,7.1 )
  7178  
  7179   "^DD",200, 200,0,"PT" ,694.801,. 04)
  7180  
  7181   "^DD",200, 200,0,"PT" ,698,300)
  7182  
  7183   "^DD",200, 200,0,"PT" ,698,301)
  7184  
  7185   "^DD",200, 200,0,"PT" ,698,302)
  7186  
  7187   "^DD",200, 200,0,"PT" ,698,701)
  7188  
  7189   "^DD",200, 200,0,"PT" ,698.1,300 )
  7190  
  7191   "^DD",200, 200,0,"PT" ,698.1,301 )
  7192  
  7193   "^DD",200, 200,0,"PT" ,698.1,302 )
  7194  
  7195   "^DD",200, 200,0,"PT" ,698.1,701 )
  7196  
  7197   "^DD",200, 200,0,"PT" ,698.2,300 )
  7198  
  7199   "^DD",200, 200,0,"PT" ,698.2,301 )
  7200  
  7201   "^DD",200, 200,0,"PT" ,698.2,302 )
  7202  
  7203   "^DD",200, 200,0,"PT" ,698.2,701 )
  7204  
  7205   "^DD",200, 200,0,"PT" ,698.3,2)
  7206  
  7207   "^DD",200, 200,0,"PT" ,698.3,300 )
  7208  
  7209   "^DD",200, 200,0,"PT" ,698.3,301 )
  7210  
  7211   "^DD",200, 200,0,"PT" ,698.3,701 )
  7212  
  7213   "^DD",200, 200,0,"PT" ,699,6)
  7214  
  7215   "^DD",200, 200,0,"PT" ,699,200)
  7216  
  7217   "^DD",200, 200,0,"PT" ,699,201)
  7218  
  7219   "^DD",200, 200,0,"PT" ,699,701)
  7220  
  7221   "^DD",200, 200,0,"PT" ,699,1500)
  7222  
  7223   "^DD",200, 200,0,"PT" ,699,1503)
  7224  
  7225   "^DD",200, 200,0,"PT" ,699,1512)
  7226  
  7227   "^DD",200, 200,0,"PT" ,699.5,6)
  7228  
  7229   "^DD",200, 200,0,"PT" ,699.5,701 )
  7230  
  7231   "^DD",200, 200,0,"PT" ,699.5,150 0)
  7232  
  7233   "^DD",200, 200,0,"PT" ,699.5,150 3)
  7234  
  7235   "^DD",200, 200,0,"PT" ,699.5,151 2)
  7236  
  7237   "^DD",200, 200,0,"PT" ,700,10)
  7238  
  7239   "^DD",200, 200,0,"PT" ,700,31)
  7240  
  7241   "^DD",200, 200,0,"PT" ,700,34)
  7242  
  7243   "^DD",200, 200,0,"PT" ,700,701)
  7244  
  7245   "^DD",200, 200,0,"PT" ,700,1500)
  7246  
  7247   "^DD",200, 200,0,"PT" ,700,1503)
  7248  
  7249   "^DD",200, 200,0,"PT" ,700,1512)
  7250  
  7251   "^DD",200, 200,0,"PT" ,700.021,. 01)
  7252  
  7253   "^DD",200, 200,0,"PT" ,701,314)
  7254  
  7255   "^DD",200, 200,0,"PT" ,701,701)
  7256  
  7257   "^DD",200, 200,0,"PT" ,702,.03)
  7258  
  7259   "^DD",200, 200,0,"PT" ,703.9,.03 )
  7260  
  7261   "^DD",200, 200,0,"PT" ,704.001,. 02)
  7262  
  7263   "^DD",200, 200,0,"PT" ,704.1122, .12)
  7264  
  7265   "^DD",200, 200,0,"PT" ,704.1122, .22)
  7266  
  7267   "^DD",200, 200,0,"PT" ,704.115,. 12)
  7268  
  7269   "^DD",200, 200,0,"PT" ,704.115,. 14)
  7270  
  7271   "^DD",200, 200,0,"PT" ,704.116,. 03)
  7272  
  7273   "^DD",200, 200,0,"PT" ,704.117,. 06)
  7274  
  7275   "^DD",200, 200,0,"PT" ,704.117,. 26)
  7276  
  7277   "^DD",200, 200,0,"PT" ,704.119,. 05)
  7278  
  7279   "^DD",200, 200,0,"PT" ,704.1211, .05)
  7280  
  7281   "^DD",200, 200,0,"PT" ,704.1212, .04)
  7282  
  7283   "^DD",200, 200,0,"PT" ,704.202,. 05)
  7284  
  7285   "^DD",200, 200,0,"PT" ,704.209,. 02)
  7286  
  7287   "^DD",200, 200,0,"PT" ,704.209,. 03)
  7288  
  7289   "^DD",200, 200,0,"PT" ,712,3.1)
  7290  
  7291   "^DD",200, 200,0,"PT" ,712,4.2)
  7292  
  7293   "^DD",200, 200,0,"PT" ,712,4.7)
  7294  
  7295   "^DD",200, 200,0,"PT" ,712,5.2)
  7296  
  7297   "^DD",200, 200,0,"PT" ,712,6.2)
  7298  
  7299   "^DD",200, 200,0,"PT" ,712,7.2)
  7300  
  7301   "^DD",200, 200,0,"PT" ,712,8.2)
  7302  
  7303   "^DD",200, 200,0,"PT" ,712,9.2)
  7304  
  7305   "^DD",200, 200,0,"PT" ,712.01,1. 3)
  7306  
  7307   "^DD",200, 200,0,"PT" ,713,3)
  7308  
  7309   "^DD",200, 200,0,"PT" ,713.1,4)
  7310  
  7311   "^DD",200, 200,0,"PT" ,713.2,6)
  7312  
  7313   "^DD",200, 200,0,"PT" ,721,10)
  7314  
  7315   "^DD",200, 200,0,"PT" ,721,13)
  7316  
  7317   "^DD",200, 200,0,"PT" ,721,15)
  7318  
  7319   "^DD",200, 200,0,"PT" ,721,17)
  7320  
  7321   "^DD",200, 200,0,"PT" ,721.042,. 01)
  7322  
  7323   "^DD",200, 200,0,"PT" ,727,16)
  7324  
  7325   "^DD",200, 200,0,"PT" ,727.805,1 1)
  7326  
  7327   "^DD",200, 200,0,"PT" ,740.51,.0 2)
  7328  
  7329   "^DD",200, 200,0,"PT" ,741,8)
  7330  
  7331   "^DD",200, 200,0,"PT" ,741,9)
  7332  
  7333   "^DD",200, 200,0,"PT" ,741.01,.0 2)
  7334  
  7335   "^DD",200, 200,0,"PT" ,741.024,. 01)
  7336  
  7337   "^DD",200, 200,0,"PT" ,741.3,.01 )
  7338  
  7339   "^DD",200, 200,0,"PT" ,742.4,.06 )
  7340  
  7341   "^DD",200, 200,0,"PT" ,745.1,8)
  7342  
  7343   "^DD",200, 200,0,"PT" ,745.1,9)
  7344  
  7345   "^DD",200, 200,0,"PT" ,745.117,. 01)
  7346  
  7347   "^DD",200, 200,0,"PT" ,745.128,. 01)
  7348  
  7349   "^DD",200, 200,0,"PT" ,748,.055)
  7350  
  7351   "^DD",200, 200,0,"PT" ,748.02,.0 1)
  7352  
  7353   "^DD",200, 200,0,"PT" ,757.201,. 01)
  7354  
  7355   "^DD",200, 200,0,"PT" ,776.1061, .01)
  7356  
  7357   "^DD",200, 200,0,"PT" ,776.2,7)
  7358  
  7359   "^DD",200, 200,0,"PT" ,776.4,.08 )
  7360  
  7361   "^DD",200, 200,0,"PT" ,776.5,.01 )
  7362  
  7363   "^DD",200, 200,0,"PT" ,779.11,2)
  7364  
  7365   "^DD",200, 200,0,"PT" ,785,14)
  7366  
  7367   "^DD",200, 200,0,"PT" ,785.5,14)
  7368  
  7369   "^DD",200, 200,0,"PT" ,789.5,3)
  7370  
  7371   "^DD",200, 200,0,"PT" ,790.01,.0 1)
  7372  
  7373   "^DD",200, 200,0,"PT" ,790.08,.0 7)
  7374  
  7375   "^DD",200, 200,0,"PT" ,790.08,.1 8)
  7376  
  7377   "^DD",200, 200,0,"PT" ,790.1,.07 )
  7378  
  7379   "^DD",200, 200,0,"PT" ,790.1,.18 )
  7380  
  7381   "^DD",200, 200,0,"PT" ,790.72,.0 1)
  7382  
  7383   "^DD",200, 200,0,"PT" ,798,2.1)
  7384  
  7385   "^DD",200, 200,0,"PT" ,798,6.1)
  7386  
  7387   "^DD",200, 200,0,"PT" ,798.114,. 01)
  7388  
  7389   "^DD",200, 200,0,"PT" ,798.7,7)
  7390  
  7391   "^DD",200, 200,0,"PT" ,798.8,.08 )
  7392  
  7393   "^DD",200, 200,0,"PT" ,799.4,9.0 5)
  7394  
  7395   "^DD",200, 200,0,"PT" ,801.03,1)
  7396  
  7397   "^DD",200, 200,0,"PT" ,801.13,1)
  7398  
  7399   "^DD",200, 200,0,"PT" ,801.44,1)
  7400  
  7401   "^DD",200, 200,0,"PT" ,801.5,.05 )
  7402  
  7403   "^DD",200, 200,0,"PT" ,801.55,.0 5)
  7404  
  7405   "^DD",200, 200,0,"PT" ,801.9,.05 )
  7406  
  7407   "^DD",200, 200,0,"PT" ,802.42,1)
  7408  
  7409   "^DD",200, 200,0,"PT" ,810.1,15)
  7410  
  7411   "^DD",200, 200,0,"PT" ,810.14,.0 1)
  7412  
  7413   "^DD",200, 200,0,"PT" ,810.24,1)
  7414  
  7415   "^DD",200, 200,0,"PT" ,810.3,.05 )
  7416  
  7417   "^DD",200, 200,0,"PT" ,810.42,1)
  7418  
  7419   "^DD",200, 200,0,"PT" ,810.5,.07 )
  7420  
  7421   "^DD",200, 200,0,"PT" ,810.54,.0 1)
  7422  
  7423   "^DD",200, 200,0,"PT" ,810.72,1)
  7424  
  7425   "^DD",200, 200,0,"PT" ,810.82,1)
  7426  
  7427   "^DD",200, 200,0,"PT" ,810.9002, 1)
  7428  
  7429   "^DD",200, 200,0,"PT" ,811.21,1)
  7430  
  7431   "^DD",200, 200,0,"PT" ,811.42,1)
  7432  
  7433   "^DD",200, 200,0,"PT" ,811.53,1)
  7434  
  7435   "^DD",200, 200,0,"PT" ,811.63,1)
  7436  
  7437   "^DD",200, 200,0,"PT" ,811.9001, 1)
  7438  
  7439   "^DD",200, 200,0,"PT" ,812,.01)
  7440  
  7441   "^DD",200, 200,0,"PT" ,853.51,.0 6)
  7442  
  7443   "^DD",200, 200,0,"PT" ,853.81,.0 2)
  7444  
  7445   "^DD",200, 200,0,"PT" ,853.81,4)
  7446  
  7447   "^DD",200, 200,0,"PT" ,853.81,12 )
  7448  
  7449   "^DD",200, 200,0,"PT" ,863.5,.03 )
  7450  
  7451   "^DD",200, 200,0,"PT" ,910.11,.0 1)
  7452  
  7453   "^DD",200, 200,0,"PT" ,910.85,.0 2)
  7454  
  7455   "^DD",200, 200,0,"PT" ,912,.06)
  7456  
  7457   "^DD",200, 200,0,"PT" ,912,5.03)
  7458  
  7459   "^DD",200, 200,0,"PT" ,912,5.07)
  7460  
  7461   "^DD",200, 200,0,"PT" ,912,6.03)
  7462  
  7463   "^DD",200, 200,0,"PT" ,912.17,.0 1)
  7464  
  7465   "^DD",200, 200,0,"PT" ,912.17,.0 3)
  7466  
  7467   "^DD",200, 200,0,"PT" ,912.5,.01 )
  7468  
  7469   "^DD",200, 200,0,"PT" ,913,2.01)
  7470  
  7471   "^DD",200, 200,0,"PT" ,913,2.02)
  7472  
  7473   "^DD",200, 200,0,"PT" ,914,.06)
  7474  
  7475   "^DD",200, 200,0,"PT" ,916.05,1)
  7476  
  7477   "^DD",200, 200,0,"PT" ,916.31,.0 1)
  7478  
  7479   "^DD",200, 200,0,"PT" ,984.9,.02 )
  7480  
  7481   "^DD",200, 200,0,"PT" ,984.9,2.0 1)
  7482  
  7483   "^DD",200, 200,0,"PT" ,987.5,10)
  7484  
  7485   "^DD",200, 200,0,"PT" ,991.12,8)
  7486  
  7487   "^DD",200, 200,0,"PT" ,991.8,50)
  7488  
  7489   "^DD",200, 200,0,"PT" ,991.8,51)
  7490  
  7491   "^DD",200, 200,0,"PT" ,991.8,52)
  7492  
  7493   "^DD",200, 200,0,"PT" ,991.8,53)
  7494  
  7495   "^DD",200, 200,0,"PT" ,991.8,54)
  7496  
  7497   "^DD",200, 200,0,"PT" ,991.8,55)
  7498  
  7499   "^DD",200, 200,0,"PT" ,991.8,104 )
  7500  
  7501   "^DD",200, 200,0,"PT" ,991.8,109 )
  7502  
  7503   "^DD",200, 200,0,"PT" ,991.8,114 )
  7504  
  7505   "^DD",200, 200,0,"PT" ,991.8,119 )
  7506  
  7507   "^DD",200, 200,0,"PT" ,999.21,.0 1)
  7508  
  7509   "^DD",200, 200,0,"PT" ,1927.09,. 01)
  7510  
  7511   "^DD",200, 200,0,"PT" ,1927.4,2)
  7512  
  7513   "^DD",200, 200,0,"PT" ,1927.431, 2)
  7514  
  7515   "^DD",200, 200,0,"PT" ,1927.461, 3)
  7516  
  7517   "^DD",200, 200,0,"PT" ,1927.47,2 )
  7518  
  7519   "^DD",200, 200,0,"PT" ,1927.49,3 )
  7520  
  7521   "^DD",200, 200,0,"PT" ,1927.5,3)
  7522  
  7523   "^DD",200, 200,0,"PT" ,1927.6,3)
  7524  
  7525   "^DD",200, 200,0,"PT" ,2005,8)
  7526  
  7527   "^DD",200, 200,0,"PT" ,2005,30)
  7528  
  7529   "^DD",200, 200,0,"PT" ,2005.0021 ,.01)
  7530  
  7531   "^DD",200, 200,0,"PT" ,2005.05,3 )
  7532  
  7533   "^DD",200, 200,0,"PT" ,2005.099, .03)
  7534  
  7535   "^DD",200, 200,0,"PT" ,2005.1,8)
  7536  
  7537   "^DD",200, 200,0,"PT" ,2005.1,30 )
  7538  
  7539   "^DD",200, 200,0,"PT" ,2005.199, .03)
  7540  
  7541   "^DD",200, 200,0,"PT" ,2005.201, .01)
  7542  
  7543   "^DD",200, 200,0,"PT" ,2005.42,1 .2)
  7544  
  7545   "^DD",200, 200,0,"PT" ,2005.42,2 .2)
  7546  
  7547   "^DD",200, 200,0,"PT" ,2005.65,1 0)
  7548  
  7549   "^DD",200, 200,0,"PT" ,2005.87,1 2)
  7550  
  7551   "^DD",200, 200,0,"PT" ,2005.87,2 0)
  7552  
  7553   "^DD",200, 200,0,"PT" ,2005.87,2 2)
  7554  
  7555   "^DD",200, 200,0,"PT" ,2006.03,1 )
  7556  
  7557   "^DD",200, 200,0,"PT" ,2006.1,30 0)
  7558  
  7559   "^DD",200, 200,0,"PT" ,2006.137, .01)
  7560  
  7561   "^DD",200, 200,0,"PT" ,2006.1664 ,.01)
  7562  
  7563   "^DD",200, 200,0,"PT" ,2006.18,1 )
  7564  
  7565   "^DD",200, 200,0,"PT" ,2006.563, 119)
  7566  
  7567   "^DD",200, 200,0,"PT" ,2006.563, 128)
  7568  
  7569   "^DD",200, 200,0,"PT" ,2006.5843 ,.01)
  7570  
  7571   "^DD",200, 200,0,"PT" ,2006.5849 ,13)
  7572  
  7573   "^DD",200, 200,0,"PT" ,2006.68,1 )
  7574  
  7575   "^DD",200, 200,0,"PT" ,2006.81,1 )
  7576  
  7577   "^DD",200, 200,0,"PT" ,2006.82,1 )
  7578  
  7579   "^DD",200, 200,0,"PT" ,2006.941, 8)
  7580  
  7581   "^DD",200, 200,0,"PT" ,2006.941, 10)
  7582  
  7583   "^DD",200, 200,0,"PT" ,2006.9421 ,1)
  7584  
  7585   "^DD",200, 200,0,"PT" ,2006.9422 ,2)
  7586  
  7587   "^DD",200, 200,0,"PT" ,2006.95,2 )
  7588  
  7589   "^DD",200, 200,0,"PT" ,2006.961, 2)
  7590  
  7591   "^DD",200, 200,0,"PT" ,2040,11)
  7592  
  7593   "^DD",200, 200,0,"PT" ,2056.1442 004,5)
  7594  
  7595   "^DD",200, 200,0,"PT" ,2056.1442 004,6)
  7596  
  7597   "^DD",200, 200,0,"PT" ,2056.1442 004,7)
  7598  
  7599   "^DD",200, 200,0,"PT" ,2100,.95)
  7600  
  7601   "^DD",200, 200,0,"PT" ,2100,9.01 )
  7602  
  7603   "^DD",200, 200,0,"PT" ,2101.3,.8 )
  7604  
  7605   "^DD",200, 200,0,"PT" ,2101.3,5)
  7606  
  7607   "^DD",200, 200,0,"PT" ,2101.6,2)
  7608  
  7609   "^DD",200, 200,0,"PT" ,2260,44)
  7610  
  7611   "^DD",200, 200,0,"PT" ,2260,48)
  7612  
  7613   "^DD",200, 200,0,"PT" ,2260,53)
  7614  
  7615   "^DD",200, 200,0,"PT" ,2260,53.1 )
  7616  
  7617   "^DD",200, 200,0,"PT" ,2260,56)
  7618  
  7619   "^DD",200, 200,0,"PT" ,2260,67)
  7620  
  7621   "^DD",200, 200,0,"PT" ,2260,76)
  7622  
  7623   "^DD",200, 200,0,"PT" ,2260,79)
  7624  
  7625   "^DD",200, 200,0,"PT" ,2260,119)
  7626  
  7627   "^DD",200, 200,0,"PT" ,2260,169)
  7628  
  7629   "^DD",200, 200,0,"PT" ,2260,221)
  7630  
  7631   "^DD",200, 200,0,"PT" ,2260,265)
  7632  
  7633   "^DD",200, 200,0,"PT" ,2260,309)
  7634  
  7635   "^DD",200, 200,0,"PT" ,2260,312)
  7636  
  7637   "^DD",200, 200,0,"PT" ,2260.095, 7)
  7638  
  7639   "^DD",200, 200,0,"PT" ,2260.095, 9)
  7640  
  7641   "^DD",200, 200,0,"PT" ,2262.03,7 )
  7642  
  7643   "^DD",200, 200,0,"PT" ,2263.7,2)
  7644  
  7645   "^DD",200, 200,0,"PT" ,2264,.5)
  7646  
  7647   "^DD",200, 200,0,"PT" ,2264,47)
  7648  
  7649   "^DD",200, 200,0,"PT" ,2264,83)
  7650  
  7651   "^DD",200, 200,0,"PT" ,6001,.04)
  7652  
  7653   "^DD",200, 200,0,"PT" ,6002.01,1 0)
  7654  
  7655   "^DD",200, 200,0,"PT" ,6002.03,5 )
  7656  
  7657   "^DD",200, 200,0,"PT" ,6914,.5)
  7658  
  7659   "^DD",200, 200,0,"PT" ,6914,90.1 )
  7660  
  7661   "^DD",200, 200,0,"PT" ,6914,99)
  7662  
  7663   "^DD",200, 200,0,"PT" ,6914.1,1)
  7664  
  7665   "^DD",200, 200,0,"PT" ,6914.1,20 )
  7666  
  7667   "^DD",200, 200,0,"PT" ,6914.1100 206,.01)
  7668  
  7669   "^DD",200, 200,0,"PT" ,6915.2,1. 5)
  7670  
  7671   "^DD",200, 200,0,"PT" ,6915.2,30 2)
  7672  
  7673   "^DD",200, 200,0,"PT" ,6915.3,1. 5)
  7674  
  7675   "^DD",200, 200,0,"PT" ,6915.3,30 2)
  7676  
  7677   "^DD",200, 200,0,"PT" ,6915.4,1. 5)
  7678  
  7679   "^DD",200, 200,0,"PT" ,6915.4,30 2)
  7680  
  7681   "^DD",200, 200,0,"PT" ,6915.5,1. 5)
  7682  
  7683   "^DD",200, 200,0,"PT" ,6915.5,30 2)
  7684  
  7685   "^DD",200, 200,0,"PT" ,6915.6,1. 5)
  7686  
  7687   "^DD",200, 200,0,"PT" ,6915.6,30 2)
  7688  
  7689   "^DD",200, 200,0,"PT" ,6916.3,1)
  7690  
  7691   "^DD",200, 200,0,"PT" ,6916.3,3)
  7692  
  7693   "^DD",200, 200,0,"PT" ,6916.3,6)
  7694  
  7695   "^DD",200, 200,0,"PT" ,6916.3,8)
  7696  
  7697   "^DD",200, 200,0,"PT" ,6916.31,3 )
  7698  
  7699   "^DD",200, 200,0,"PT" ,6917,11)
  7700  
  7701   "^DD",200, 200,0,"PT" ,6917,13)
  7702  
  7703   "^DD",200, 200,0,"PT" ,6917,15)
  7704  
  7705   "^DD",200, 200,0,"PT" ,6918.01,2 )
  7706  
  7707   "^DD",200, 200,0,"PT" ,6920,7.5)
  7708  
  7709   "^DD",200, 200,0,"PT" ,6925,245)
  7710  
  7711   "^DD",200, 200,0,"PT" ,6925,248)
  7712  
  7713   "^DD",200, 200,0,"PT" ,6925,279. 1)
  7714  
  7715   "^DD",200, 200,0,"PT" ,6925,279. 3)
  7716  
  7717   "^DD",200, 200,0,"PT" ,7100,2.1)
  7718  
  7719   "^DD",200, 200,0,"PT" ,7100,5.2)
  7720  
  7721   "^DD",200, 200,0,"PT" ,7100,124)
  7722  
  7723   "^DD",200, 200,0,"PT" ,7100.2,3)
  7724  
  7725   "^DD",200, 200,0,"PT" ,7100.3,.0 1)
  7726  
  7727   "^DD",200, 200,0,"PT" ,7100.5,1)
  7728  
  7729   "^DD",200, 200,0,"PT" ,7100.6,1)
  7730  
  7731   "^DD",200, 200,0,"PT" ,7100.7,2)
  7732  
  7733   "^DD",200, 200,0,"PT" ,7100.7,4)
  7734  
  7735   "^DD",200, 200,0,"PT" ,7101.1,.0 1)
  7736  
  7737   "^DD",200, 200,0,"PT" ,7101.2,.0 1)
  7738  
  7739   "^DD",200, 200,0,"PT" ,7101.3,.0 1)
  7740  
  7741   "^DD",200, 200,0,"PT" ,7101.4,1)
  7742  
  7743   "^DD",200, 200,0,"PT" ,7103.5,1)
  7744  
  7745   "^DD",200, 200,0,"PT" ,7104.3,.0 1)
  7746  
  7747   "^DD",200, 200,0,"PT" ,7105.1,5)
  7748  
  7749   "^DD",200, 200,0,"PT" ,7105.2,.0 1)
  7750  
  7751   "^DD",200, 200,0,"PT" ,7107.1,1)
  7752  
  7753   "^DD",200, 200,0,"PT" ,7107.6,.0 5)
  7754  
  7755   "^DD",200, 200,0,"PT" ,8925,1202 )
  7756  
  7757   "^DD",200, 200,0,"PT" ,8925,1204 )
  7758  
  7759   "^DD",200, 200,0,"PT" ,8925,1208 )
  7760  
  7761   "^DD",200, 200,0,"PT" ,8925,1209 )
  7762  
  7763   "^DD",200, 200,0,"PT" ,8925,1302 )
  7764  
  7765   "^DD",200, 200,0,"PT" ,8925,1306 )
  7766  
  7767   "^DD",200, 200,0,"PT" ,8925,1502 )
  7768  
  7769   "^DD",200, 200,0,"PT" ,8925,1508 )
  7770  
  7771   "^DD",200, 200,0,"PT" ,8925,1512 )
  7772  
  7773   "^DD",200, 200,0,"PT" ,8925,1513 )
  7774  
  7775   "^DD",200, 200,0,"PT" ,8925,1602 )
  7776  
  7777   "^DD",200, 200,0,"PT" ,8925,1610 )
  7778  
  7779   "^DD",200, 200,0,"PT" ,8925.1,.0 5)
  7780  
  7781   "^DD",200, 200,0,"PT" ,8925.1,15 03)
  7782  
  7783   "^DD",200, 200,0,"PT" ,8925.2,.0 2)
  7784  
  7785   "^DD",200, 200,0,"PT" ,8925.4,.0 2)
  7786  
  7787   "^DD",200, 200,0,"PT" ,8925.5,.0 3)
  7788  
  7789   "^DD",200, 200,0,"PT" ,8925.5,1. 02)
  7790  
  7791   "^DD",200, 200,0,"PT" ,8925.5,2. 02)
  7792  
  7793   "^DD",200, 200,0,"PT" ,8925.5,3. 03)
  7794  
  7795   "^DD",200, 200,0,"PT" ,8925.7,.0 3)
  7796  
  7797   "^DD",200, 200,0,"PT" ,8925.7,.0 5)
  7798  
  7799   "^DD",200, 200,0,"PT" ,8925.954, .01)
  7800  
  7801   "^DD",200, 200,0,"PT" ,8925.98,. 01)
  7802  
  7803   "^DD",200, 200,0,"PT" ,8925.992, .01)
  7804  
  7805   "^DD",200, 200,0,"PT" ,8926,.01)
  7806  
  7807   "^DD",200, 200,0,"PT" ,8926,.09)
  7808  
  7809   "^DD",200, 200,0,"PT" ,8927,.06)
  7810  
  7811   "^DD",200, 200,0,"PT" ,8930.3,.0 1)
  7812  
  7813   "^DD",200, 200,0,"PT" ,8972.1,.0 3)
  7814  
  7815   "^DD",200, 200,0,"PT" ,8972.1,2. 02)
  7816  
  7817   "^DD",200, 200,0,"PT" ,8973.2,.0 5)
  7818  
  7819   "^DD",200, 200,0,"PT" ,8980,4)
  7820  
  7821   "^DD",200, 200,0,"PT" ,8980.01,. 01)
  7822  
  7823   "^DD",200, 200,0,"PT" ,8980.2,.0 3)
  7824  
  7825   "^DD",200, 200,0,"PT" ,8987.16,. 01)
  7826  
  7827   "^DD",200, 200,0,"PT" ,8989.3,32 1.01)
  7828  
  7829   "^DD",200, 200,0,"PT" ,8989.3,32 1.02)
  7830  
  7831   "^DD",200, 200,0,"PT" ,8989.34,. 01)
  7832  
  7833   "^DD",200, 200,0,"PT" ,8989.5,.0 1)
  7834  
  7835   "^DD",200, 200,0,"PT" ,8991.6,.0 1)
  7836  
  7837   "^DD",200, 200,0,"PT" ,8991.6,.0 2)
  7838  
  7839   "^DD",200, 200,0,"PT" ,8991.7,.0 1)
  7840  
  7841   "^DD",200, 200,0,"PT" ,8991.7,.0 2)
  7842  
  7843   "^DD",200, 200,0,"PT" ,8992,.01)
  7844  
  7845   "^DD",200, 200,0,"PT" ,8992,.02)
  7846  
  7847   "^DD",200, 200,0,"PT" ,8992.02,. 02)
  7848  
  7849   "^DD",200, 200,0,"PT" ,8992.1,.0 5)
  7850  
  7851   "^DD",200, 200,0,"PT" ,8992.11,. 01)
  7852  
  7853   "^DD",200, 200,0,"PT" ,8992.11,. 07)
  7854  
  7855   "^DD",200, 200,0,"PT" ,8992.11,. 09)
  7856  
  7857   "^DD",200, 200,0,"PT" ,8992.111, .02)
  7858  
  7859   "^DD",200, 200,0,"PT" ,8992.112, .03)
  7860  
  7861   "^DD",200, 200,0,"PT" ,8992.113, .01)
  7862  
  7863   "^DD",200, 200,0,"PT" ,11500.1,1 .05)
  7864  
  7865   "^DD",200, 200,0,"PT" ,11500.2,1 .05)
  7866  
  7867   "^DD",200, 200,0,"PT" ,11500.3,1 .05)
  7868  
  7869   "^DD",200, 200,0,"PT" ,11500.4,1 .05)
  7870  
  7871   "^DD",200, 200,0,"PT" ,19082.1,1 )
  7872  
  7873   "^DD",200, 200,0,"PT" ,19082.5,1 )
  7874  
  7875   "^DD",200, 200,0,"PT" ,19102.2,. 01)
  7876  
  7877   "^DD",200, 200,0,"PT" ,19234.2,. 06)
  7878  
  7879   "^DD",200, 200,0,"PT" ,19234.3,. 06)
  7880  
  7881   "^DD",200, 200,0,"PT" ,19234.4,. 06)
  7882  
  7883   "^DD",200, 200,0,"PT" ,19600.1,4 )
  7884  
  7885   "^DD",200, 200,0,"PT" ,19600.1,4 .1)
  7886  
  7887   "^DD",200, 200,0,"PT" ,19601.13, 1)
  7888  
  7889   "^DD",200, 200,0,"PT" ,19601.13, 6)
  7890  
  7891   "^DD",200, 200,0,"PT" ,19601.13, 18.6)
  7892  
  7893   "^DD",200, 200,0,"PT" ,19601.131 9,.01)
  7894  
  7895   "^DD",200, 200,0,"PT" ,19601.145 ,2)
  7896  
  7897   "^DD",200, 200,0,"PT" ,19601.22, 1)
  7898  
  7899   "^DD",200, 200,0,"PT" ,19601.22, 6)
  7900  
  7901   "^DD",200, 200,0,"PT" ,19601.22, 18.6)
  7902  
  7903   "^DD",200, 200,0,"PT" ,19601.22, 28)
  7904  
  7905   "^DD",200, 200,0,"PT" ,19601.221 9,.01)
  7906  
  7907   "^DD",200, 200,0,"PT" ,19601.226 ,2)
  7908  
  7909   "^DD",200, 200,0,"PT" ,19605.2,2 )
  7910  
  7911   "^DD",200, 200,0,"PT" ,19605.2,6 8)
  7912  
  7913   "^DD",200, 200,0,"PT" ,19605.2,7 0)
  7914  
  7915   "^DD",200, 200,0,"PT" ,19605.3,1 )
  7916  
  7917   "^DD",200, 200,0,"PT" ,19605.3,4 )
  7918  
  7919   "^DD",200, 200,0,"PT" ,19605.31, 1)
  7920  
  7921   "^DD",200, 200,0,"PT" ,19605.4,1 )
  7922  
  7923   "^DD",200, 200,0,"PT" ,19610.1,6 )
  7924  
  7925   "^DD",200, 200,0,"PT" ,19610.4,3 )
  7926  
  7927   "^DD",200, 200,0,"PT" ,19610.4,5 .01)
  7928  
  7929   "^DD",200, 200,0,"PT" ,19610.4,1 0004)
  7930  
  7931   "^DD",200, 200,0,"PT" ,19610.5,3 )
  7932  
  7933   "^DD",200, 200,0,"PT" ,19610.5,3 .1)
  7934  
  7935   "^DD",200, 200,0,"PT" ,19610.5,3 .5)
  7936  
  7937   "^DD",200, 200,0,"PT" ,19610.5,1 4.01)
  7938  
  7939   "^DD",200, 200,0,"PT" ,19610.5,1 4.03)
  7940  
  7941   "^DD",200, 200,0,"PT" ,19610.5,2 2)
  7942  
  7943   "^DD",200, 200,0,"PT" ,19610.5,3 0)
  7944  
  7945   "^DD",200, 200,0,"PT" ,19610.51, 3)
  7946  
  7947   "^DD",200, 200,0,"PT" ,19610.55, .05)
  7948  
  7949   "^DD",200, 200,0,"PT" ,19610.6,. 01)
  7950  
  7951   "^DD",200, 200,0,"PT" ,19610.61, .02)
  7952  
  7953   "^DD",200, 200,0,"PT" ,19610.7,. 02)
  7954  
  7955   "^DD",200, 200,0,"PT" ,19610.7,. 08)
  7956  
  7957   "^DD",200, 200,0,"PT" ,19610.8,. 03)
  7958  
  7959   "^DD",200, 200,0,"PT" ,19610.8,. 1)
  7960  
  7961   "^DD",200, 200,0,"PT" ,19610.8,3 0.1)
  7962  
  7963   "^DD",200, 200,0,"PT" ,19610.82, 6)
  7964  
  7965   "^DD",200, 200,0,"PT" ,19617,1.0 1)
  7966  
  7967   "^DD",200, 200,0,"PT" ,19617,1.0 3)
  7968  
  7969   "^DD",200, 200,0,"PT" ,19617,1.0 5)
  7970  
  7971   "^DD",200, 200,0,"PT" ,19617,1.0 7)
  7972  
  7973   "^DD",200, 200,0,"PT" ,19619,1)
  7974  
  7975   "^DD",200, 200,0,"PT" ,19619.1,. 01)
  7976  
  7977   "^DD",200, 200,0,"PT" ,19619.9,3 )
  7978  
  7979   "^DD",200, 200,0,"PT" ,19620,.03 )
  7980  
  7981   "^DD",200, 200,0,"PT" ,19620,4.0 6)
  7982  
  7983   "^DD",200, 200,0,"PT" ,19620.1,. 08)
  7984  
  7985   "^DD",200, 200,0,"PT" ,19620.1,. 09)
  7986  
  7987   "^DD",200, 200,0,"PT" ,19620.14, .01)
  7988  
  7989   "^DD",200, 200,0,"PT" ,19620.2,. 03)
  7990  
  7991   "^DD",200, 200,0,"PT" ,19620.21, .03)
  7992  
  7993   "^DD",200, 200,0,"PT" ,19620.29, .03)
  7994  
  7995   "^DD",200, 200,0,"PT" ,19620.3,. 04)
  7996  
  7997   "^DD",200, 200,0,"PT" ,19620.3,. 06)
  7998  
  7999   "^DD",200, 200,0,"PT" ,19620.35, .01)
  8000  
  8001   "^DD",200, 200,0,"PT" ,19620.701 ,1.01)
  8002  
  8003   "^DD",200, 200,0,"PT" ,19620.701 ,1.03)
  8004  
  8005   "^DD",200, 200,0,"PT" ,19620.871 ,.02)
  8006  
  8007   "^DD",200, 200,0,"PT" ,19620.91, .04)
  8008  
  8009   "^DD",200, 200,0,"PT" ,19620.94, .01)
  8010  
  8011   "^DD",200, 200,0,"PT" ,19621,.04 )
  8012  
  8013   "^DD",200, 200,0,"PT" ,19625,1)
  8014  
  8015   "^DD",200, 200,0,"PT" ,19625,1.0 2)
  8016  
  8017   "^DD",200, 200,0,"PT" ,19625,1.0 4)
  8018  
  8019   "^DD",200, 200,0,"PT" ,19625,1.0 6)
  8020  
  8021   "^DD",200, 200,0,"PT" ,19625,1.0 8)
  8022  
  8023   "^DD",200, 200,0,"PT" ,19625.11, .04)
  8024  
  8025   "^DD",200, 200,0,"PT" ,19625.11, .05)
  8026  
  8027   "^DD",200, 200,0,"PT" ,19625.3,. 03)
  8028  
  8029   "^DD",200, 200,0,"PT" ,19640.1,. 05)
  8030  
  8031   "^DD",200, 200,0,"PT" ,19640.11, .05)
  8032  
  8033   "^DD",200, 200,0,"PT" ,19640.12, .01)
  8034  
  8035   "^DD",200, 200,0,"PT" ,19640.19, .04)
  8036  
  8037   "^DD",200, 200,0,"PT" ,19640.28, .01)
  8038  
  8039   "^DD",200, 200,0,"PT" ,19640.31, 2)
  8040  
  8041   "^DD",200, 200,0,"PT" ,19640.31, 3)
  8042  
  8043   "^DD",200, 200,0,"PT" ,19640.32, 3)
  8044  
  8045   "^DD",200, 200,0,"PT" ,19640.33, 3)
  8046  
  8047   "^DD",200, 200,0,"PT" ,19640.381 ,.03)
  8048  
  8049   "^DD",200, 200,0,"PT" ,19640.45, 1.01)
  8050  
  8051   "^DD",200, 200,0,"PT" ,19640.45, 1.03)
  8052  
  8053   "^DD",200, 200,0,"PT" ,19640.45, 2.01)
  8054  
  8055   "^DD",200, 200,0,"PT" ,19640.45, 2.03)
  8056  
  8057   "^DD",200, 200,0,"PT" ,19640.46, .02)
  8058  
  8059   "^DD",200, 200,0,"PT" ,19640.46, .04)
  8060  
  8061   "^DD",200, 200,0,"PT" ,19640.46, .06)
  8062  
  8063   "^DD",200, 200,0,"PT" ,19640.46, .08)
  8064  
  8065   "^DD",200, 200,0,"PT" ,19640.69, .04)
  8066  
  8067   "^DD",200, 200,0,"PT" ,19640.9,1 3)
  8068  
  8069   "^DD",200, 200,0,"PT" ,19672,3)
  8070  
  8071   "^DD",200, 200,0,"PT" ,19905.01, .05)
  8072  
  8073   "^DD",200, 200,0,"PT" ,19908.3,. 01)
  8074  
  8075   "^DD",200, 200,0,"PT" ,19925.01, .05)
  8076  
  8077   "^DD",200, 200,0,"PT" ,100150.00 42,.03)
  8078  
  8079   "^DD",200, 200,0,"PT" ,100150.00 43,.03)
  8080  
  8081   "^DD",200, 200,0,"PT" ,100150.00 43,.06)
  8082  
  8083   "^DD",200, 200,0,"PT" ,100199.00 1,1)
  8084  
  8085   "^DD",200, 200,0,"PT" ,100199.00 1,5)
  8086  
  8087   "^DD",200, 200,0,"PT" ,100215,2)
  8088  
  8089   "^DD",200, 200,0,"PT" ,177100.13 ,2)
  8090  
  8091   "^DD",200, 200,0,"PT" ,189001.1, 3)
  8092  
  8093   "^DD",200, 200,0,"PT" ,190077,3)
  8094  
  8095   "^DD",200, 200,0,"PT" ,190077.02 ,.01)
  8096  
  8097   "^DD",200, 200,0,"PT" ,442029.01 ,7)
  8098  
  8099   "^DD",200, 200,0,"PT" ,442056,3)
  8100  
  8101   "^DD",200, 200,0,"PT" ,442062.11 ,1)
  8102  
  8103   "^DD",200, 200,0,"PT" ,442074.02 ,3)
  8104  
  8105   "^DD",200, 200,0,"PT" ,442076.05 ,.01)
  8106  
  8107   "^DD",200, 200,0,"PT" ,442080,.0 1)
  8108  
  8109   "^DD",200, 200,0,"PT" ,442096,.0 1)
  8110  
  8111   "^DD",200, 200,0,"PT" ,442103,4)
  8112  
  8113   "^DD",200, 200,0,"PT" ,442103.08 ,5)
  8114  
  8115   "^DD",200, 200,0,"PT" ,442104,5)
  8116  
  8117   "^DD",200, 200,0,"PT" ,442104,14 )
  8118  
  8119   "^DD",200, 200,0,"PT" ,442104,24 )
  8120  
  8121   "^DD",200, 200,0,"PT" ,442104,33 )
  8122  
  8123   "^DD",200, 200,0,"PT" ,442108,.0 1)
  8124  
  8125   "^DD",200, 200,0,"PT" ,442113,1)
  8126  
  8127   "^DD",200, 200,0,"PT" ,442118,.0 1)
  8128  
  8129   "^DD",200, 200,0,"PT" ,442123,.0 1)
  8130  
  8131   "^DD",200, 200,0,"PT" ,442124.02 ,.41)
  8132  
  8133   "^DD",200, 200,0,"PT" ,442124.02 ,.42)
  8134  
  8135   "^DD",200, 200,0,"PT" ,442127,.0 1)
  8136  
  8137   "^DD",200, 200,0,"PT" ,442130,.0 1)
  8138  
  8139   "^DD",200, 200,0,"PT" ,442132,.0 1)
  8140  
  8141   "^DD",200, 200,0,"PT" ,442147,.0 1)
  8142  
  8143   "^DD",200, 200,0,"PT" ,442149.03 ,17)
  8144  
  8145   "^DD",200, 200,0,"PT" ,442150.02 ,3)
  8146  
  8147   "^DD",200, 200,0,"PT" ,442150.03 ,5)
  8148  
  8149   "^DD",200, 200,0,"PT" ,442150.04 ,4)
  8150  
  8151   "^DD",200, 200,0,"PT" ,442150.05 ,4)
  8152  
  8153   "^DD",200, 200,0,"PT" ,442150.06 ,4)
  8154  
  8155   "^DD",200, 200,0,"PT" ,442150.07 ,3)
  8156  
  8157   "^DD",200, 200,0,"PT" ,442150.08 ,3)
  8158  
  8159   "^DD",200, 200,0,"PT" ,442166,4)
  8160  
  8161   "^DD",200, 200,0,"PT" ,442166.08 ,5)
  8162  
  8163   "^DD",200, 200,0,"PT" ,442176.02 ,1)
  8164  
  8165   "^DD",200, 200,0,"PT" ,442199,.0 1)
  8166  
  8167   "^DD",200, 200,0,"PT" ,442204,10 )
  8168  
  8169   "^DD",200, 200,0,"PT" ,442204,10 .5)
  8170  
  8171   "^DD",200, 200,0,"PT" ,442215,.0 1)
  8172  
  8173   "^DD",200, 200,0,"PT" ,442227.01 ,4)
  8174  
  8175   "^DD",200, 200,0,"PT" ,442253,3)
  8176  
  8177   "^DD",200, 200,0,"PT" ,442315.11 ,3)
  8178  
  8179   "^DD",200, 200,0,"PT" ,442315.11 ,4.5)
  8180  
  8181   "^DD",200, 200,0,"PT" ,500803,8)
  8182  
  8183   "^DD",200, 200,0,"PT" ,500803,9. 5)
  8184  
  8185   "^DD",200, 200,0,"PT" ,500803,17 )
  8186  
  8187   "^DD",200, 200,0,"PT" ,500803,29 )
  8188  
  8189   "^DD",200, 200,0,"PT" ,500803,42 )
  8190  
  8191   "^DD",200, 200,0,"PT" ,501013,2)
  8192  
  8193   "^DD",200, 200,0,"PT" ,501013.01 ,.01)
  8194  
  8195   "^DD",200, 200,0,"PT" ,503335,2. 2)
  8196  
  8197   "^DD",200, 200,0,"PT" ,503335,2. 4)
  8198  
  8199   "^DD",200, 200,0,"PT" ,503336,10 )
  8200  
  8201   "^DD",200, 200,0,"PT" ,503336,12 )
  8202  
  8203   "^DD",200, 200,0,"PT" ,503338.08 ,.01)
  8204  
  8205   "^DD",200, 200,0,"PT" ,503340,10 )
  8206  
  8207   "^DD",200, 200,0,"PT" ,503340,12 )
  8208  
  8209   "^DD",200, 200,0,"PT" ,509850.3, .07)
  8210  
  8211   "^DD",200, 200,0,"PT" ,509850.9, .03)
  8212  
  8213   "^DD",200, 200,0,"PT" ,509850.9, .16)
  8214  
  8215   "^DD",200, 200,0,"PT" ,519033,.0 1)
  8216  
  8217   "^DD",200, 200,0,"PT" ,519034,5)
  8218  
  8219   "^DD",200, 200,0,"PT" ,519036,7)
  8220  
  8221   "^DD",200, 200,0,"PT" ,519036.04 ,1)
  8222  
  8223   "^DD",200, 200,0,"PT" ,519037,2)
  8224  
  8225   "^DD",200, 200,0,"PT" ,519037,10 )
  8226  
  8227   "^DD",200, 200,0,"PT" ,531167.41 ,.01)
  8228  
  8229   "^DD",200, 200,0,"PT" ,534401.03 ,4)
  8230  
  8231   "^DD",200, 200,0,"PT" ,554566,.0 1)
  8232  
  8233   "^DD",200, 200,0,"PT" ,554689,.0 3)
  8234  
  8235   "^DD",200, 200,0,"PT" ,554689,.0 7)
  8236  
  8237   "^DD",200, 200,0,"PT" ,575001.01 ,.01)
  8238  
  8239   "^DD",200, 200,0,"PT" ,575066.02 ,.01)
  8240  
  8241   "^DD",200, 200,0,"PT" ,575066.18 ,1)
  8242  
  8243   "^DD",200, 200,0,"PT" ,575066.19 ,.01)
  8244  
  8245   "^DD",200, 200,0,"PT" ,612418,.0 2)
  8246  
  8247   "^DD",200, 200,0,"PT" ,612418,.0 4)
  8248  
  8249   "^DD",200, 200,0,"PT" ,612418.31 ,5)
  8250  
  8251   "^DD",200, 200,0,"PT" ,612418.31 ,6)
  8252  
  8253   "^DD",200, 200,0,"PT" ,612418.5, 7.8)
  8254  
  8255   "^DD",200, 200,0,"PT" ,618350,2)
  8256  
  8257   "^DD",200, 200,0,"PT" ,618351,4)
  8258  
  8259   "^DD",200, 200,0,"PT" ,626140,.0 3)
  8260  
  8261   "^DD",200, 200,0,"PT" ,626140,.0 8)
  8262  
  8263   "^DD",200, 200,0,"PT" ,626140.01 ,.03)
  8264  
  8265   "^DD",200, 200,0,"PT" ,641217.11 9,17)
  8266  
  8267   "^DD",200, 200,0,"PT" ,644210.1, .01)
  8268  
  8269   "^DD",200, 200,0,"PT" ,644210.2, 8)
  8270  
  8271   "^DD",200, 200,0,"PT" ,644210.2, 11)
  8272  
  8273   "^DD",200, 200,0,"PT" ,644210.2, 13)
  8274  
  8275   "^DD",200, 200,0,"PT" ,644210.2, 17)
  8276  
  8277   "^DD",200, 200,0,"PT" ,644210.2, 70)
  8278  
  8279   "^DD",200, 200,0,"PT" ,644210.2, 72)
  8280  
  8281   "^DD",200, 200,0,"PT" ,644210.2, 74)
  8282  
  8283   "^DD",200, 200,0,"PT" ,644210.24 ,1)
  8284  
  8285   "^DD",200, 200,0,"PT" ,644210.3, .01)
  8286  
  8287   "^DD",200, 200,0,"PT" ,644210.5, .01)
  8288  
  8289   "^DD",200, 200,0,"PT" ,644210.5, 4)
  8290  
  8291   "^DD",200, 200,0,"PT" ,648552,2)
  8292  
  8293   "^DD",200, 200,0,"PT" ,648552.03 ,.01)
  8294  
  8295   "^DD",200, 200,0,"PT" ,648552.07 ,.01)
  8296  
  8297   "^DD",200, 200,0,"PT" ,648552.41 ,.01)
  8298  
  8299   "^DD",200, 200,0,"PT" ,654009.41 ,.01)
  8300  
  8301   "^DD",200, 200,0,"PT" ,666079.01 5,.01)
  8302  
  8303   "^DD",200, 200,0,"PT" ,666900.5, .01)
  8304  
  8305   "^DD",200, 200,0,"PT" ,666900.51 ,3)
  8306  
  8307   "^DD",200, 200,0,"PT" ,666900.55 ,.01)
  8308  
  8309   "^DD",200, 200,0,"PT" ,666900.55 1,.01)
  8310  
  8311   "^DD",200, 200,0,"PT" ,677082.05 ,.01)
  8312  
  8313   "^DD",200, 200,0,"PT" ,677082.11 ,.01)
  8314  
  8315   "^DD",200, 200,0,"PT" ,791810,.0 5)
  8316  
  8317   "^DD",200, 200,0,"PT" ,791810,.0 8)
  8318  
  8319   "^DD",200, 200,0,"PT" ,791810,.1 )
  8320  
  8321   "^DD",200, 200,0,"PT" ,791810,2. 03)
  8322  
  8323   "^DD",200, 200,0,"PT" ,791810,2. 07)
  8324  
  8325   "^DD",200, 200,0,"PT" ,791810,10 .06)
  8326  
  8327   "^DD",200, 200,0,"PT" ,791810.01 01,90.01)
  8328  
  8329   "^DD",200, 200,0,"PT" ,791810.01 01,90.08)
  8330  
  8331   "^DD",200, 200,0,"PT" ,791810.01 01,90.1)
  8332  
  8333   "^DD",200, 200,0,"PT" ,791810.01 01,90.12)
  8334  
  8335   "^DD",200, 200,0,"PT" ,791810.01 01,90.13)
  8336  
  8337   "^DD",200, 200,0,"PT" ,791810.10 1102,.05)
  8338  
  8339   "^DD",200, 200,0,"PT" ,791810.20 1101,.07)
  8340  
  8341   "^DD",200, 200,0,"PT" ,791812,.0 5)
  8342  
  8343   "^DD",200, 200,0,"PT" ,791812.01 01,.02)
  8344  
  8345   "^DD",200, 200,0,"PT" ,791813,2. 03)
  8346  
  8347   "^DD",200, 200,0,"PT" ,791813.01 01,.01)
  8348  
  8349   "^DD",200, 200,0,"PT" ,791814,.0 3)
  8350  
  8351   "^DD",200, 200,0,"PT" ,791814,2. 03)
  8352  
  8353   "^DD",200, 200,0,"PT" ,800000.14 ,.03)
  8354  
  8355   "^DD",200, 200,0,"PT" ,800000.14 ,.05)
  8356  
  8357   "^DD",200, 200,0,"PT" ,800000.14 ,.07)
  8358  
  8359   "^DD",200, 200,0,"PT" ,800000.14 ,.09)
  8360  
  8361   "^DD",200, 200,0,"PT" ,800000.14 ,.11)
  8362  
  8363   "^DD",200, 200,0,"PT" ,800000.14 2,.03)
  8364  
  8365   "^DD",200, 200,0,"PT" ,800001.2, .04)
  8366  
  8367   "^DD",200, 200,0,"PT" ,800001.21 ,.02)
  8368  
  8369   "^DD",200, 200,0,"PT" ,9000010,. 23)
  8370  
  8371   "^DD",200, 200,0,"PT" ,9000010.0 6,.01)
  8372  
  8373   "^DD",200, 200,0,"PT" ,9000010.0 7,1202)
  8374  
  8375   "^DD",200, 200,0,"PT" ,9000010.0 7,1204)
  8376  
  8377   "^DD",200, 200,0,"PT" ,9000010.1 1,1202)
  8378  
  8379   "^DD",200, 200,0,"PT" ,9000010.1 1,1204)
  8380  
  8381   "^DD",200, 200,0,"PT" ,9000010.1 1,1206)
  8382  
  8383   "^DD",200, 200,0,"PT" ,9000010.1 1,1214)
  8384  
  8385   "^DD",200, 200,0,"PT" ,9000010.1 1,1217)
  8386  
  8387   "^DD",200, 200,0,"PT" ,9000010.1 1,1219)
  8388  
  8389   "^DD",200, 200,0,"PT" ,9000010.1 1,1404)
  8390  
  8391   "^DD",200, 200,0,"PT" ,9000010.1 2,.07)
  8392  
  8393   "^DD",200, 200,0,"PT" ,9000010.1 2,1202)
  8394  
  8395   "^DD",200, 200,0,"PT" ,9000010.1 2,1204)
  8396  
  8397   "^DD",200, 200,0,"PT" ,9000010.1 3,1202)
  8398  
  8399   "^DD",200, 200,0,"PT" ,9000010.1 3,1204)
  8400  
  8401   "^DD",200, 200,0,"PT" ,9000010.1 5,1202)
  8402  
  8403   "^DD",200, 200,0,"PT" ,9000010.1 5,1204)
  8404  
  8405   "^DD",200, 200,0,"PT" ,9000010.1 6,1202)
  8406  
  8407   "^DD",200, 200,0,"PT" ,9000010.1 6,1204)
  8408  
  8409   "^DD",200, 200,0,"PT" ,9000010.1 8,1202)
  8410  
  8411   "^DD",200, 200,0,"PT" ,9000010.1 8,1204)
  8412  
  8413   "^DD",200, 200,0,"PT" ,9000010.2 3,1202)
  8414  
  8415   "^DD",200, 200,0,"PT" ,9000010.2 3,1204)
  8416  
  8417   "^DD",200, 200,0,"PT" ,9000010.7 07,1204)
  8418  
  8419   "^DD",200, 200,0,"PT" ,9000011,1 .03)
  8420  
  8421   "^DD",200, 200,0,"PT" ,9000011,1 .04)
  8422  
  8423   "^DD",200, 200,0,"PT" ,9000011,1 .05)
  8424  
  8425   "^DD",200, 200,0,"PT" ,9000011.1 111,.06)
  8426  
  8427   "^DD",200, 200,0,"PT" ,9000080.1 1,1202)
  8428  
  8429   "^DD",200, 200,0,"PT" ,9000080.1 1,1204)
  8430  
  8431   "^DD",200, 200,0,"PT" ,9000080.1 1,1206)
  8432  
  8433   "^DD",200, 200,0,"PT" ,9000080.1 1,1214)
  8434  
  8435   "^DD",200, 200,0,"PT" ,9000080.1 1,1217)
  8436  
  8437   "^DD",200, 200,0,"PT" ,9000080.1 1,1219)
  8438  
  8439   "^DD",200, 200,0,"PT" ,9000080.1 1,1404)
  8440  
  8441   "^DD",200, 200,0,"PT" ,9000080.1 1,88001)
  8442  
  8443   "^DD",200, 200,0,"PT" ,9002313.0 2,903)
  8444  
  8445   "^DD",200, 200,0,"PT" ,9002313.0 2,907)
  8446  
  8447   "^DD",200, 200,0,"PT" ,9002313.5 6,1900.01)
  8448  
  8449   "^DD",200, 200,0,"PT" ,9002313.5 6,1900.02)
  8450  
  8451   "^DD",200, 200,0,"PT" ,9002313.5 6,1900.03)
  8452  
  8453   "^DD",200, 200,0,"PT" ,9002313.5 7,13)
  8454  
  8455   "^DD",200, 200,0,"PT" ,9002313.5 7,304)
  8456  
  8457   "^DD",200, 200,0,"PT" ,9002313.5 7,307)
  8458  
  8459   "^DD",200, 200,0,"PT" ,9002313.5 7111,.02)
  8460  
  8461   "^DD",200, 200,0,"PT" ,9002313.5 9,13)
  8462  
  8463   "^DD",200, 200,0,"PT" ,9002313.5 9,304)
  8464  
  8465   "^DD",200, 200,0,"PT" ,9002313.5 9,307)
  8466  
  8467   "^DD",200, 200,0,"PT" ,9002313.5 9111,.02)
  8468  
  8469   "^DD",200, 200,0,"PT" ,9002313.7 7,6.02)
  8470  
  8471   "^DD",200, 200,0,"PT" ,9002313.7 7,6.04)
  8472  
  8473   "^DD",200, 200,0,"PT" ,9002313.7 7,6.06)
  8474  
  8475   "^DD",200, 200,0,"PT" ,9002313.7 8,5.01)
  8476  
  8477   "^DD",200, 200,0,"PT" ,9002313.9 9,2500)
  8478  
  8479   "^DD",200, 200,0,"PT" ,9002313.9 9,6000)
  8480  
  8481   "^DD",200, 200,0,"PT" ,9002313.9 9,6001)
  8482  
  8483   "^DD",200, 200,0,"PT" ,9009032.4 ,.03)
  8484  
  8485   "^DD",200, 200,0,"PT" ,9009032.4 ,.04)
  8486  
  8487   "^DD",200, 200,0,"PT" ,9009032.4 ,.11)
  8488  
  8489   "^DD",200, 200,0,"PT" ,741000000 1.01,.02)
  8490  
  8491   "^DD",200, 200,0,"PT" ,741000000 1.01,.06)
  8492  
  8493   "^DD",200, 200,0,"PTC ",2005,112 .2)
  8494  
  8495   "^DD",200, 200,0,"PTC ",2005,113 .2)
  8496  
  8497   "^DD",200, 200,0,"PTC ",2005.1,1 12.2)
  8498  
  8499   "^DD",200, 200,0,"PTC ",2005.1,1 13.2)
  8500  
  8501   "^DD",200, 200,0,"SCR ")
  8502   I $$SCR200 ^XUSER
  8503   "^DD",200, 200,0,"VRP K")
  8504   XU
  8505   "^DD",200, 200,.01,0)
  8506   NAME^RFX^^ 0;1^K XLFN C K:($L(X, ",")'=2) X  I $D(X) S  XLFNC=X,( X,XLFNC)=$ $FORMAT^XL FNAME7(.XL FNC,3,35,, ,,,2) K:$L (X)>35!($L (X)<3)!($L (X,",")'=2 )!(X'?1.E1 ","1.E) X, XLFNC K:'$ G(XUITNAME ) XLFNC
  8507   "^DD",200, 200,.01,.1 )
  8508  
  8509   "^DD",200, 200,.01,1, 0)
  8510   ^.1
  8511   "^DD",200, 200,.01,1, 1,0)
  8512   200^B
  8513   "^DD",200, 200,.01,1, 1,1)
  8514   S ^VA(200, "B",$E(X,1 ,30),DA)=" "
  8515   "^DD",200, 200,.01,1, 1,2)
  8516   K ^VA(200, "B",$E(X,1 ,30),DA)
  8517   "^DD",200, 200,.01,1, 2,0)
  8518   200^AE^MUM PS
  8519   "^DD",200, 200,.01,1, 2,1)
  8520   S X1=$P($G (^VA(200,D A,1)),"^", 8) I X1=""  S $P(^VA( 200,DA,1), "^",7,8)=D T_"^"_DUZ
  8521   "^DD",200, 200,.01,1, 2,2)
  8522   Q
  8523   "^DD",200, 200,.01,1, 2,3)
  8524   Stuffing C reator and  date
  8525   "^DD",200, 200,.01,1, 2,"%D",0)
  8526   ^^1^1^2990 617^^
  8527   "^DD",200, 200,.01,1, 2,"%D",1,0 )
  8528   This X-ref  stuffs th e DATE ENT ERED and C REATOR fie lds on a n ew entry.
  8529   "^DD",200, 200,.01,1, 2,"DT")
  8530   2990617
  8531   "^DD",200, 200,.01,1, 3,0)
  8532   200^AMPI01 ^MUMPS
  8533   "^DD",200, 200,.01,1, 3,1)
  8534   D XREF^XUM PI(DA)
  8535   "^DD",200, 200,.01,1, 3,2)
  8536   D XREF^XUM PI(DA)
  8537   "^DD",200, 200,.01,1, 3,"%D",0)
  8538   ^^4^4^3100 903^
  8539   "^DD",200, 200,.01,1, 3,"%D",1,0 )
  8540   This cross  reference  sets the  Requires T ransmissio n (#902) f ield if th e
  8541   "^DD",200, 200,.01,1, 3,"%D",2,0 )
  8542   enumeratio n process  has begun  for this f ile.  Sett ing that f ield will
  8543   "^DD",200, 200,.01,1, 3,"%D",3,0 )
  8544   result in  a VPID bei ng assigne d or an up date messa ge being s ent to the  MPI
  8545   "^DD",200, 200,.01,1, 3,"%D",4,0 )
  8546   for this c hange in d ata.
  8547   "^DD",200, 200,.01,1, 3,"DT")
  8548   3100805
  8549   "^DD",200, 200,.01,1, 5,0)
  8550   200^BS5^MU MPS
  8551   "^DD",200, 200,.01,1, 5,1)
  8552   Q:$P($G(^V A(200,DA,1 )),U,9)']" "  S ^VA(2 00,"BS5",$ E(X,1)_$E( $P(^(1),U, 9),6,9),DA )=""
  8553   "^DD",200, 200,.01,1, 5,2)
  8554   Q:$P($G(^V A(200,DA,1 )),U,9)']" "  K ^VA(2 00,"BS5",$ E(X,1)_$E( $P(^(1),U, 9),6,9),DA )
  8555   "^DD",200, 200,.01,1, 5,3)
  8556   Special BS 5 lookup X -ref
  8557   "^DD",200, 200,.01,1, 5,"%D",0)
  8558   ^^3^3^2990 617^^
  8559   "^DD",200, 200,.01,1, 5,"%D",1,0 )
  8560   This X-ref  builds th e 'BS5' X- ref on nam e changes.
  8561   "^DD",200, 200,.01,1, 5,"%D",2,0 )
  8562   The BS5 is  the first  letter of  the last  name conca tinated wi th the las t
  8563   "^DD",200, 200,.01,1, 5,"%D",3,0 )
  8564   four digit s of the S SN.
  8565   "^DD",200, 200,.01,1, 8,0)
  8566   200^AG^MUM PS
  8567   "^DD",200, 200,.01,1, 8,1)
  8568   F X1=0:0 S  X1=$O(^VA (200,"AB", X1)) Q:X1' >0  I $D(^ VA(200,"AB ",X1,DA)), $S($D(^DIC (19.1,X1,0 )):$P(^(0) ,U,3)["l", 1:0) S X2= ^(0),^VA(2 00,"AK."_$ P(X2,U),X, DA)=""
  8569   "^DD",200, 200,.01,1, 8,2)
  8570   S X1="AK."  F X2=0:0  S X1=$O(^V A(200,X1))  Q:$E(X1,3 )'="."  K  ^VA(200,X1 ,X,DA)
  8571   "^DD",200, 200,.01,1, 8,3)
  8572   Updates th e AK.key s pecial loo kup X-ref.
  8573   "^DD",200, 200,.01,1, 8,"%D",0)
  8574   ^^1^1^2920 513^
  8575   "^DD",200, 200,.01,1, 8,"%D",1,0 )
  8576   Builds the  AK.key sp ecial look up X-ref w hen there  is a name  change.
  8577   "^DD",200, 200,.01,1, 8,"DT")
  8578   2890929
  8579   "^DD",200, 200,.01,1, 9,0)
  8580   200^ASX^MU MPS
  8581   "^DD",200, 200,.01,1, 9,1)
  8582   S ^VA(200, "ASX",$$EN ^XUA4A71(X ),DA)=""
  8583   "^DD",200, 200,.01,1, 9,2)
  8584   K ^VA(200, "ASX",$$EN ^XUA4A71(X ),DA)
  8585   "^DD",200, 200,.01,1, 9,3)
  8586   LAYGO SOUN DEX X-REF
  8587   "^DD",200, 200,.01,1, 9,"%D",0)
  8588   ^^3^3^2920 513^^
  8589   "^DD",200, 200,.01,1, 9,"%D",1,0 )
  8590   This build s a sounde x X-ref so  that a ch eck for si mular name s can be
  8591   "^DD",200, 200,.01,1, 9,"%D",2,0 )
  8592   done at th e time of  LAYGOing t o the file .
  8593   "^DD",200, 200,.01,1, 9,"%D",3,0 )
  8594   It calls X UA4A71 to  convert X.  The LAYGO  test call s XUA4A7.
  8595   "^DD",200, 200,.01,1, 9,"DT")
  8596   2920117
  8597   "^DD",200, 200,.01,1, 10,0)
  8598   ^^BULLETIN  MESSAGE
  8599   "^DD",200, 200,.01,1, 10,1)
  8600   S Y(0)=X,D 0=DA K XMB ,XMY S XMB (1)=Y(0),X MB="XMNEWU SER" D ^XM B:$D(^XMB( 3.6,"B",XM B)) K Y,XM B
  8601   "^DD",200, 200,.01,1, 10,2)
  8602   Q
  8603   "^DD",200, 200,.01,1, 10,3)
  8604   New User B ulletin
  8605   "^DD",200, 200,.01,1, 10,"%D",0)
  8606   ^^1^1^3000 719^
  8607   "^DD",200, 200,.01,1, 10,"%D",1, 0)
  8608   This bulle tin is sen t whenever  a new use r is added  to the Ne w Person f ile.
  8609   "^DD",200, 200,.01,1, 10,"CREATE  PARAMETER  #1")
  8610   NAME
  8611   "^DD",200, 200,.01,1, 10,"CREATE  VALUE")
  8612   XMNEWUSER
  8613   "^DD",200, 200,.01,1, 10,"DELETE  VALUE")
  8614   NO EFFECT
  8615   "^DD",200, 200,.01,1, 10,"DT")
  8616   3000719
  8617   "^DD",200, 200,.01,1, 11,0)
  8618   ^^TRIGGER^ 46.11^.02
  8619   "^DD",200, 200,.01,1, 11,1)
  8620   Q
  8621   "^DD",200, 200,.01,1, 11,2)
  8622   K DIV S DI V=X,D0=DA, DIV(0)=D0  S Y(0)=X S  X=$P($G(^ DG(43,1,"H L7")),U,4) =1 I X S X =DIV X ^DD (200,.01,1 ,11,89.2)  S Y(101)=$ S($D(^DGRU (46.11,D0, 0)):^(0),1 :"") S X=$ P(Y(101),U ,2) S D0=I (0,0) S DI U=X K Y S  X=DIV S X= X X ^DD(20 0,.01,1,11 ,2.4)
  8623   "^DD",200, 200,.01,1, 11,2.4)
  8624   S DIH=$S($ D(^DGRU(46 .11,DIV(0) ,0)):^(0), 1:""),DIV= X I $D(^(0 )) S $P(^( 0),U,2)=DI V,DIH=46.1 1,DIG=.02  D ^DICR:$O (^DD(DIH,D IG,1,0))>0
  8625   "^DD",200, 200,.01,1, 11,89.2)
  8626   S I(0,0)=$ S($D(D0):D 0,1:""),Y( 1)=$S($D(^ VA(200,D0, 0)):^(0),1 :"") S X=$ P(Y(1),U,1 ),X=X S X= X K DIC S  DIC="^DGRU (46.11,",D IC(0)="NMF L",X=""""_ X_"""" D ^ DIC S (D,D 0,DIV(0))= +Y
  8627   "^DD",200, 200,.01,1, 11,"%D",0)
  8628   ^^2^2^2991 018^
  8629   "^DD",200, 200,.01,1, 11,"%D",1, 0)
  8630   Trigger th e Name fie ld before  it was cha nged into  the RAI MD S MONITOR
  8631   "^DD",200, 200,.01,1, 11,"%D",2, 0)
  8632   file whene ver the Na me field o f the New  Person fil e is added  or change d.
  8633   "^DD",200, 200,.01,1, 11,"CREATE  VALUE")
  8634   NO EFFECT
  8635   "^DD",200, 200,.01,1, 11,"DELETE  CONDITION ")
  8636   S X=$P($G( ^DG(43,1," HL7")),U,4 )=1
  8637   "^DD",200, 200,.01,1, 11,"DELETE  VALUE")
  8638   OLD NAME
  8639   "^DD",200, 200,.01,1, 11,"DIC")
  8640   LOOKUP
  8641   "^DD",200, 200,.01,1, 11,"DT")
  8642   2991018
  8643   "^DD",200, 200,.01,1, 11,"FIELD" )
  8644   NAME:RAI M DS MONITOR :#.02
  8645   "^DD",200, 200,.01,1, 12,0)
  8646   ^^TRIGGER^ 46.11^.03
  8647   "^DD",200, 200,.01,1, 12,1)
  8648   K DIV S DI V=X,D0=DA, DIV(0)=D0  S Y(0)=X S  X=$P($G(^ DG(43,1,"H L7")),U,4) =1 I X S X =DIV X ^DD (200,.01,1 ,12,89.2)  S Y(101)=$ S($D(^DGRU (46.11,D0, 0)):^(0),1 :"") S X=$ P(Y(101),U ,3) S D0=I (0,0) S DI U=X K Y S  X=DIV S X= 200 X ^DD( 200,.01,1, 12,1.4)
  8649   "^DD",200, 200,.01,1, 12,1.4)
  8650   S DIH=$S($ D(^DGRU(46 .11,DIV(0) ,0)):^(0), 1:""),DIV= X I $D(^(0 )) S $P(^( 0),U,3)=DI V,DIH=46.1 1,DIG=.03  D ^DICR:$O (^DD(DIH,D IG,1,0))>0
  8651   "^DD",200, 200,.01,1, 12,2)
  8652   Q
  8653   "^DD",200, 200,.01,1, 12,89.2)
  8654   S I(0,0)=$ S($D(D0):D 0,1:""),Y( 1)=$S($D(^ VA(200,D0, 0)):^(0),1 :"") S X=$ P(Y(1),U,1 ),X=X S X= X K DIC S  DIC="^DGRU (46.11,",D IC(0)="NMF L" D ^DIC  S (D,D0,DI V(0))=+Y
  8655   "^DD",200, 200,.01,1, 12,"%D",0)
  8656   ^^2^2^2991 018^
  8657   "^DD",200, 200,.01,1, 12,"%D",1, 0)
  8658   Trigger th e New Pers on file nu mber (#200 ) into the  RAI MDS M ONITOR
  8659   "^DD",200, 200,.01,1, 12,"%D",2, 0)
  8660   file whene ver the Ne w Person n ame field  is added o r changed.
  8661   "^DD",200, 200,.01,1, 12,"CREATE  CONDITION ")
  8662   S X=$P($G( ^DG(43,1," HL7")),U,4 )=1
  8663   "^DD",200, 200,.01,1, 12,"CREATE  VALUE")
  8664   S X=200
  8665   "^DD",200, 200,.01,1, 12,"DELETE  VALUE")
  8666   NO EFFECT
  8667   "^DD",200, 200,.01,1, 12,"DIC")
  8668   LOOKUP
  8669   "^DD",200, 200,.01,1, 12,"DT")
  8670   2991018
  8671   "^DD",200, 200,.01,1, 12,"FIELD" )
  8672   NAME:RAI M DS MONITOR :#.03
  8673   "^DD",200, 200,.01,1, 13,0)
  8674   ^^TRIGGER^ 46.11^.04
  8675   "^DD",200, 200,.01,1, 13,1)
  8676   K DIV S DI V=X,D0=DA, DIV(0)=D0  S Y(0)=X S  X=$P($G(^ DG(43,1,"H L7")),U,4) =1 I X S X =DIV X ^DD (200,.01,1 ,13,89.2)  S Y(101)=$ S($D(^DGRU (46.11,D0, 0)):^(0),1 :"") S X=$ P(Y(101),U ,4) S D0=I (0,0) S DI U=X K Y S  X=DIV S X= DA X ^DD(2 00,.01,1,1 3,1.4)
  8677   "^DD",200, 200,.01,1, 13,1.4)
  8678   S DIH=$S($ D(^DGRU(46 .11,DIV(0) ,0)):^(0), 1:""),DIV= X I $D(^(0 )) S $P(^( 0),U,4)=DI V,DIH=46.1 1,DIG=.04  D ^DICR:$O (^DD(DIH,D IG,1,0))>0
  8679   "^DD",200, 200,.01,1, 13,2)
  8680   Q
  8681   "^DD",200, 200,.01,1, 13,89.2)
  8682   S I(0,0)=$ S($D(D0):D 0,1:""),Y( 1)=$S($D(^ VA(200,D0, 0)):^(0),1 :"") S X=$ P(Y(1),U,1 ),X=X S X= X K DIC S  DIC="^DGRU (46.11,",D IC(0)="NMF " D ^DIC S  (D,D0,DIV (0))=+Y
  8683   "^DD",200, 200,.01,1, 13,"%D",0)
  8684   ^^2^2^2991 018^
  8685   "^DD",200, 200,.01,1, 13,"%D",1, 0)
  8686   Trigger th e internal  entry num ber of the  entry whi ch was cha nged or ad ded
  8687   "^DD",200, 200,.01,1, 13,"%D",2, 0)
  8688   in the New  Person fi le, into t he RAI MDS  MONITOR f ile.
  8689   "^DD",200, 200,.01,1, 13,"CREATE  CONDITION ")
  8690   S X=$P($G( ^DG(43,1," HL7")),U,4 )=1
  8691   "^DD",200, 200,.01,1, 13,"CREATE  VALUE")
  8692   S X=DA
  8693   "^DD",200, 200,.01,1, 13,"DELETE  VALUE")
  8694   NO EFFECT
  8695   "^DD",200, 200,.01,1, 13,"DIC")
  8696   LOOKUP
  8697   "^DD",200, 200,.01,1, 13,"DT")
  8698   2991018
  8699   "^DD",200, 200,.01,1, 13,"FIELD" )
  8700   NAME:RAI M DS MONITOR :#.04
  8701   "^DD",200, 200,.01,3)
  8702   Answer mus t be 3-35  upper-case  character s in lengt h, and be  in the for mat Family (Last),Giv en(First)  Middle Suf fix. Enter  '??' for  more help.
  8703   "^DD",200, 200,.01,21 ,0)
  8704   ^^6^6^3040 421^
  8705   "^DD",200, 200,.01,21 ,1,0)
  8706   Enter only  data that  is actual ly part of  the perso n's name.  Do not
  8707   "^DD",200, 200,.01,21 ,2,0)
  8708   include ex tra titles , identifi cation, fl ags, local  informati on, etc.
  8709   "^DD",200, 200,.01,21 ,3,0)
  8710   Enter the  person's n ame in 'LA ST,FIRST M IDDLE SUFF IX' format .
  8711   "^DD",200, 200,.01,21 ,4,0)
  8712   This value  must be 3 -35 charac ters in le ngth and m ay contain  only
  8713   "^DD",200, 200,.01,21 ,5,0)
  8714   uppercase  alpha char acters, sp aces, apos trophes, h yphens and  one comma .
  8715   "^DD",200, 200,.01,21 ,6,0)
  8716   All other  characters  and paren thetical t ext will b e removed.
  8717   "^DD",200, 200,.01,"A UDIT")
  8718   n
  8719   "^DD",200, 200,.01,"A X")
  8720  
  8721   "^DD",200, 200,.01,"D EL",1,0)
  8722   I 1 W *7,"   PERSONS  CAN'T BE D ELETED!!"
  8723   "^DD",200, 200,.01,"D T")
  8724   3100805
  8725   "^DD",200, 200,.01,"L AYGO",1,0)
  8726   D LAYGO^XU A4A7
  8727   "^DD",200, 200,.111,0 )
  8728   STREET ADD RESS 1^F^^ .11;1^K:X[ """"!($A(X )=45) X I  $D(X) K:$L (X)>50!($L (X)<2) X
  8729   "^DD",200, 200,.111,1 ,0)
  8730   ^.1
  8731   "^DD",200, 200,.111,1 ,1,0)
  8732   200^AMPI11 1^MUMPS
  8733   "^DD",200, 200,.111,1 ,1,1)
  8734   D XREF^XUM PI(DA)
  8735   "^DD",200, 200,.111,1 ,1,2)
  8736   D XREF^XUM PI(DA)
  8737   "^DD",200, 200,.111,1 ,1,"%D",0)
  8738   ^^4^4^3100 903^
  8739   "^DD",200, 200,.111,1 ,1,"%D",1, 0)
  8740   This cross  reference  sets the  Requires T ransmissio n (#902) f ield if th e
  8741   "^DD",200, 200,.111,1 ,1,"%D",2, 0)
  8742   enumeratio n process  has begun  for this f ile.  Sett ing that f ield will
  8743   "^DD",200, 200,.111,1 ,1,"%D",3, 0)
  8744   result in  a VPID bei ng assigne d or an up date messa ge being s ent to the  MPI
  8745   "^DD",200, 200,.111,1 ,1,"%D",4, 0)
  8746   for this c hange in d ata.
  8747   "^DD",200, 200,.111,1 ,1,"DT")
  8748   3100805
  8749   "^DD",200, 200,.111,3 )
  8750   ANSWER MUS T BE 2-50  CHARACTERS  IN LENGTH
  8751   "^DD",200, 200,.111,2 1,0)
  8752   ^^2^2^2920 513^^^^
  8753   "^DD",200, 200,.111,2 1,1,0)
  8754   This is th e first li ne of the  street add ress of th e permanen t
  8755   "^DD",200, 200,.111,2 1,2,0)
  8756    address o f the new  person.
  8757   "^DD",200, 200,.111," DT")
  8758   3100805
  8759   "^DD",200, 200,.112,0 )
  8760   STREET ADD RESS 2^F^^ .11;2^K:X[ """"!($A(X )=45) X I  $D(X) K:$L (X)>50!($L (X)<2) X
  8761   "^DD",200, 200,.112,1 ,0)
  8762   ^.1
  8763   "^DD",200, 200,.112,1 ,1,0)
  8764   200^AMPI11 2^MUMPS
  8765   "^DD",200, 200,.112,1 ,1,1)
  8766   D XREF^XUM PI(DA)
  8767   "^DD",200, 200,.112,1 ,1,2)
  8768   D XREF^XUM PI(DA)
  8769   "^DD",200, 200,.112,1 ,1,"%D",0)
  8770   ^^4^4^3100 903^
  8771   "^DD",200, 200,.112,1 ,1,"%D",1, 0)
  8772   This cross  reference  sets the  Requires T ransmissio n (#902) f ield if th e
  8773   "^DD",200, 200,.112,1 ,1,"%D",2, 0)
  8774   enumeratio n process  has begun  for this f ile.  Sett ing that f ield will
  8775   "^DD",200, 200,.112,1 ,1,"%D",3, 0)
  8776   result in  a VPID bei ng assigne d or an up date messa ge being s ent to the  MPI
  8777   "^DD",200, 200,.112,1 ,1,"%D",4, 0)
  8778   for this c hange in d ata.
  8779   "^DD",200, 200,.112,1 ,1,"DT")
  8780   3100805
  8781   "^DD",200, 200,.112,3 )
  8782   ANSWER MUS T BE 2-50  CHARACTERS  IN LENGTH
  8783   "^DD",200, 200,.112,2 1,0)
  8784   ^^2^2^2920 513^^^^
  8785   "^DD",200, 200,.112,2 1,1,0)
  8786    This is t he second  line of th e street a ddress of  the perman ent
  8787   "^DD",200, 200,.112,2 1,2,0)
  8788   address of  the new p erson.
  8789   "^DD",200, 200,.112," DT")
  8790   3100805
  8791   "^DD",200, 200,.113,0 )
  8792   STREET ADD RESS 3^F^^ .11;3^K:X[ """"!($A(X )=45) X I  $D(X) K:$L (X)>50!($L (X)<2) X
  8793   "^DD",200, 200,.113,1 ,0)
  8794   ^.1
  8795   "^DD",200, 200,.113,1 ,1,0)
  8796   200^AMPI11 3^MUMPS
  8797   "^DD",200, 200,.113,1 ,1,1)
  8798   D XREF^XUM PI(DA)
  8799   "^DD",200, 200,.113,1 ,1,2)
  8800   D XREF^XUM PI(DA)
  8801   "^DD",200, 200,.113,1 ,1,"%D",0)
  8802   ^^4^4^3100 903^
  8803   "^DD",200, 200,.113,1 ,1,"%D",1, 0)
  8804   This cross  reference  sets the  Requires T ransmissio n (#902) f ield if th e
  8805   "^DD",200, 200,.113,1 ,1,"%D",2, 0)
  8806   enumeratio n process  has begun  for this f ile.  Sett ing that f ield will
  8807   "^DD",200, 200,.113,1 ,1,"%D",3, 0)
  8808   result in  a VPID bei ng assigne d or an up date messa ge being s ent to the  MPI
  8809   "^DD",200, 200,.113,1 ,1,"%D",4, 0)
  8810   for this c hange in d ata.
  8811   "^DD",200, 200,.113,1 ,1,"DT")
  8812   3100805
  8813   "^DD",200, 200,.113,3 )
  8814   ANSWER MUS T BE 2-50  CHARACTERS  IN LENGTH
  8815   "^DD",200, 200,.113,2 1,0)
  8816   ^^2^2^2920 513^^^^
  8817   "^DD",200, 200,.113,2 1,1,0)
  8818   This is th e third li ne of the  street add ress of th e permanen t
  8819   "^DD",200, 200,.113,2 1,2,0)
  8820   address of  the new p erson.
  8821   "^DD",200, 200,.113," DT")
  8822   3100805
  8823   "^DD",200, 200,.114,0 )
  8824   CITY^F^^.1 1;4^K:X["" ""!($A(X)= 45) X I $D (X) K:$L(X )>30!($L(X )<2) X
  8825   "^DD",200, 200,.114,1 ,0)
  8826   ^.1
  8827   "^DD",200, 200,.114,1 ,1,0)
  8828   200^AMPI11 4^MUMPS
  8829   "^DD",200, 200,.114,1 ,1,1)
  8830   D XREF^XUM PI(DA)
  8831   "^DD",200, 200,.114,1 ,1,2)
  8832   D XREF^XUM PI(DA)
  8833   "^DD",200, 200,.114,1 ,1,"%D",0)
  8834   ^^4^4^3100 903^
  8835   "^DD",200, 200,.114,1 ,1,"%D",1, 0)
  8836   This cross  reference  sets the  Requires T ransmissio n (#902) f ield if th e
  8837   "^DD",200, 200,.114,1 ,1,"%D",2, 0)
  8838   enumeratio n process  has begun  for this f ile.  Sett ing that f ield will
  8839   "^DD",200, 200,.114,1 ,1,"%D",3, 0)
  8840   result in  a VPID bei ng assigne d or an up date messa ge being s ent to the  MPI
  8841   "^DD",200, 200,.114,1 ,1,"%D",4, 0)
  8842   for this c hange in d ata.
  8843   "^DD",200, 200,.114,1 ,1,"DT")
  8844   3100805
  8845   "^DD",200, 200,.114,3 )
  8846   ANSWER MUS T BE 2-30  CHARACTERS  IN LENGTH
  8847   "^DD",200, 200,.114,2 1,0)
  8848   ^^2^2^2920 513^^^^
  8849   "^DD",200, 200,.114,2 1,1,0)
  8850   This is th e city of  the perman ent addres s of
  8851   "^DD",200, 200,.114,2 1,2,0)
  8852   the new pe rson.
  8853   "^DD",200, 200,.114," DT")
  8854   3100805
  8855   "^DD",200, 200,.115,0 )
  8856   STATE^P5'^ DIC(5,^.11 ;5^Q
  8857   "^DD",200, 200,.115,1 ,0)
  8858   ^.1
  8859   "^DD",200, 200,.115,1 ,1,0)
  8860   200^AMPI11 5^MUMPS
  8861   "^DD",200, 200,.115,1 ,1,1)
  8862   D XREF^XUM PI(DA)
  8863   "^DD",200, 200,.115,1 ,1,2)
  8864   D XREF^XUM PI(DA)
  8865   "^DD",200, 200,.115,1 ,1,"%D",0)
  8866   ^^4^4^3100 903^
  8867   "^DD",200, 200,.115,1 ,1,"%D",1, 0)
  8868   This cross  reference  sets the  Requires T ransmissio n (#902) f ield if th e
  8869   "^DD",200, 200,.115,1 ,1,"%D",2, 0)
  8870   enumeratio n process  has begun  for this f ile.  Sett ing that f ield will
  8871   "^DD",200, 200,.115,1 ,1,"%D",3, 0)
  8872   result in  a VPID bei ng assigne d or an up date messa ge being s ent to the  MPI
  8873   "^DD",200, 200,.115,1 ,1,"%D",4, 0)
  8874   for this c hange in d ata.
  8875   "^DD",200, 200,.115,1 ,1,"DT")
  8876   3100805
  8877   "^DD",200, 200,.115,2 1,0)
  8878   ^^2^2^2920 513^^^^
  8879   "^DD",200, 200,.115,2 1,1,0)
  8880   This is th e state of  the perma nent addre ss of
  8881   "^DD",200, 200,.115,2 1,2,0)
  8882   the new pe rson.
  8883   "^DD",200, 200,.115," DT")
  8884   3100805
  8885   "^DD",200, 200,.116,0 )
  8886   ZIP CODE^F ^^.11;6^K: $L(X)>10!( $L(X)<5)!' (X?5N!(X?5 N1"-"4N))  X
  8887   "^DD",200, 200,.116,1 ,0)
  8888   ^.1
  8889   "^DD",200, 200,.116,1 ,1,0)
  8890   200^AMPI11 6^MUMPS
  8891   "^DD",200, 200,.116,1 ,1,1)
  8892   D XREF^XUM PI(DA)
  8893   "^DD",200, 200,.116,1 ,1,2)
  8894   D XREF^XUM PI(DA)
  8895   "^DD",200, 200,.116,1 ,1,"%D",0)
  8896   ^^4^4^3100 903^
  8897   "^DD",200, 200,.116,1 ,1,"%D",1, 0)
  8898   This cross  reference  sets the  Requires T ransmissio n (#902) f ield if th e
  8899   "^DD",200, 200,.116,1 ,1,"%D",2, 0)
  8900   enumeratio n process  has begun  for this f ile.  Sett ing that f ield will
  8901   "^DD",200, 200,.116,1 ,1,"%D",3, 0)
  8902   result in  a VPID bei ng assigne d or an up date messa ge being s ent to the  MPI
  8903   "^DD",200, 200,.116,1 ,1,"%D",4, 0)
  8904   for this c hange in d ata.
  8905   "^DD",200, 200,.116,1 ,1,"DT")
  8906   3100805
  8907   "^DD",200, 200,.116,3 )
  8908   Answer wit h ZIP CODE  or ZIP+4.
  8909   "^DD",200, 200,.116,2 1,0)
  8910   ^^2^2^2920 513^^^^
  8911   "^DD",200, 200,.116,2 1,1,0)
  8912   This is th e postal Z IP code of  the
  8913   "^DD",200, 200,.116,2 1,2,0)
  8914   permanent  address of  the new p erson.
  8915   "^DD",200, 200,.116," DT")
  8916   3100805
  8917   "^DD",200, 200,.1211, 0)
  8918   TEMPORARY  ADDRESS 1^ F^^.121;1^ K:X[""""!( $A(X)=45)  X I $D(X)  K:$L(X)>30 !($L(X)<2)  X
  8919   "^DD",200, 200,.1211, 1,0)
  8920   ^.1^^0
  8921   "^DD",200, 200,.1211, 3)
  8922   ANSWER MUS T BE 2-30  CHARACTERS  IN LENGTH
  8923   "^DD",200, 200,.1211, 21,0)
  8924   ^^2^2^2920 513^^^^
  8925   "^DD",200, 200,.1211, 21,1,0)
  8926   This is th e first li ne of a te mporary ad dress
  8927   "^DD",200, 200,.1211, 21,2,0)
  8928   for the ne w person.
  8929   "^DD",200, 200,.1211, "DT")
  8930   2890418
  8931   "^DD",200, 200,.1212, 0)
  8932   TEMPORARY  ADDRESS 2^ F^^.121;2^ K:X[""""!( $A(X)=45)  X I $D(X)  K:$L(X)>30 !($L(X)<2)  X
  8933   "^DD",200, 200,.1212, 1,0)
  8934   ^.1^^0
  8935   "^DD",200, 200,.1212, 3)
  8936   ANSWER MUS T BE 2-30  CHARACTERS  IN LENGTH
  8937   "^DD",200, 200,.1212, 21,0)
  8938   ^^2^2^2920 513^^^^
  8939   "^DD",200, 200,.1212, 21,1,0)
  8940   This is th e second l ine of a t emporary a ddress
  8941   "^DD",200, 200,.1212, 21,2,0)
  8942   for the ne w person.
  8943   "^DD",200, 200,.1212, "DT")
  8944   2890418
  8945   "^DD",200, 200,.1213, 0)
  8946   TEMPORARY  ADDRESS 3^ F^^.121;3^ K:X[""""!( $A(X)=45)  X I $D(X)  K:$L(X)>30 !($L(X)<2)  X
  8947   "^DD",200, 200,.1213, 1,0)
  8948   ^.1^^0
  8949   "^DD",200, 200,.1213, 3)
  8950   ANSWER MUS T BE 2-30  CHARACTERS  IN LENGTH
  8951   "^DD",200, 200,.1213, 21,0)
  8952   ^^2^2^2920 513^^^^
  8953   "^DD",200, 200,.1213, 21,1,0)
  8954   This is th e third li ne of a te mporary ad dress
  8955   "^DD",200, 200,.1213, 21,2,0)
  8956   for the ne w person.
  8957   "^DD",200, 200,.1213, "DT")
  8958   2890418
  8959   "^DD",200, 200,.1214, 0)
  8960   TEMPORARY  CITY^F^^.1 21;4^K:X[" """!($A(X) =45) X I $ D(X) K:$L( X)>30!($L( X)<2) X
  8961   "^DD",200, 200,.1214, 1,0)
  8962   ^.1^^0
  8963   "^DD",200, 200,.1214, 3)
  8964   ANSWER MUS T BE 2-30  CHARACTERS  IN LENGTH
  8965   "^DD",200, 200,.1214, 21,0)
  8966   ^^1^1^2920 513^^^
  8967   "^DD",200, 200,.1214, 21,1,0)
  8968   This is th e city of  the tempor ary locati on for the  new perso n.
  8969   "^DD",200, 200,.1214, "DT")
  8970   2890418
  8971   "^DD",200, 200,.1215, 0)
  8972   TEMPORARY  STATE^P5'^ DIC(5,^.12 1;5^Q
  8973   "^DD",200, 200,.1215, 1,0)
  8974   ^.1^^0
  8975   "^DD",200, 200,.1215, 3)
  8976  
  8977   "^DD",200, 200,.1215, 21,0)
  8978   ^^1^1^2920 513^^^
  8979   "^DD",200, 200,.1215, 21,1,0)
  8980   This is th e state of  the tempo rary locat ion for th e new pers on.
  8981   "^DD",200, 200,.1215, "DT")
  8982   2890418
  8983   "^DD",200, 200,.1216, 0)
  8984   TEMPORARY  ZIP CODE^F ^^.121;6^K :X[""""!($ A(X)=45) X  I $D(X) K :$L(X)>5!( $L(X)<5)!' (X?5N) X
  8985   "^DD",200, 200,.1216, 1,0)
  8986   ^.1^^0
  8987   "^DD",200, 200,.1216, 3)
  8988   ANSWER MUS T BE 5 CHA RACTERS IN  LENGTH
  8989   "^DD",200, 200,.1216, 21,0)
  8990   ^^1^1^2920 513^^^
  8991   "^DD",200, 200,.1216, 21,1,0)
  8992   This is th e postal Z IP code fo r the temp orary loca tion for t he new per son.
  8993   "^DD",200, 200,.1216, "DT")
  8994   2890418
  8995   "^DD",200, 200,.1217, 0)
  8996   START DATE  OF TEMP A DDRES^D^^. 121;7^S %D T="E" D ^% DT S X=Y K :Y<1 X
  8997   "^DD",200, 200,.1217, 1,0)
  8998   ^.1^^0
  8999   "^DD",200, 200,.1217, 21,0)
  9000   ^^2^2^2920 513^^^
  9001   "^DD",200, 200,.1217, 21,1,0)
  9002   This is th e beginnin g date for  use of th e temporar y address  for the
  9003   "^DD",200, 200,.1217, 21,2,0)
  9004   new person .
  9005   "^DD",200, 200,.1217, "DT")
  9006   2890418
  9007   "^DD",200, 200,.1218, 0)
  9008   END DATE O F TEMP ADD RESS^D^^.1 21;8^S %DT ="E" D ^%D T S X=Y K: Y<1 X
  9009   "^DD",200, 200,.1218, 1,0)
  9010   ^.1^^0
  9011   "^DD",200, 200,.1218, 3)
  9012  
  9013   "^DD",200, 200,.1218, 21,0)
  9014   ^^2^2^2920 513^^^
  9015   "^DD",200, 200,.1218, 21,1,0)
  9016   This is th e ending d ate for us e of the t emporary a ddress for  the
  9017   "^DD",200, 200,.1218, 21,2,0)
  9018   new person .
  9019   "^DD",200, 200,.1218, "DT")
  9020   2890418
  9021   "^DD",200, 200,.131,0 )
  9022   PHONE (HOM E)^F^^.13; 1^K:X["""" !($A(X)=45 ) X I $D(X ) K:$L(X)> 20!($L(X)< 4)!'(X?4.2 0NP) X
  9023   "^DD",200, 200,.131,1 ,0)
  9024   ^.1
  9025   "^DD",200, 200,.131,1 ,1,0)
  9026   200^AMPI13 1^MUMPS
  9027   "^DD",200, 200,.131,1 ,1,1)
  9028   D XREF^XUM PI(DA)
  9029   "^DD",200, 200,.131,1 ,1,2)
  9030   D XREF^XUM PI(DA)
  9031   "^DD",200, 200,.131,1 ,1,"%D",0)
  9032   ^^4^4^3100 903^
  9033   "^DD",200, 200,.131,1 ,1,"%D",1, 0)
  9034   This cross  reference  sets the  Requires T ransmissio n (#902) f ield if th e
  9035   "^DD",200, 200,.131,1 ,1,"%D",2, 0)
  9036   enumeratio n process  has begun  for this f ile.  Sett ing that f ield will
  9037   "^DD",200, 200,.131,1 ,1,"%D",3, 0)
  9038   result in  a VPID bei ng assigne d or an up date messa ge being s ent to the  MPI
  9039   "^DD",200, 200,.131,1 ,1,"%D",4, 0)
  9040   for this c hange in d ata.
  9041   "^DD",200, 200,.131,1 ,1,"DT")
  9042   3100805
  9043   "^DD",200, 200,.131,3 )
  9044   Answer mus t be 4-20  characters  in length . Only num eric/punct uation cha racters wi ll be allo wed.
  9045   "^DD",200, 200,.131,2 1,0)
  9046   ^^1^1^3021 212^^^^
  9047   "^DD",200, 200,.131,2 1,1,0)
  9048   This is th e telephon e number f or the new  person.
  9049   "^DD",200, 200,.131," DT")
  9050   3100805
  9051   "^DD",200, 200,.132,0 )
  9052   OFFICE PHO NE^F^^.13; 2^K:X["""" !($A(X)=45 ) X I $D(X ) K:$L(X)> 20!($L(X)< 4)!'(X?4.2 0NP) X
  9053   "^DD",200, 200,.132,1 ,0)
  9054   ^.1^^0
  9055   "^DD",200, 200,.132,3 )
  9056   Answer mus t be 4-20  characters  in length . Only num eric/punct uation cha racters wi ll be allo wed.
  9057   "^DD",200, 200,.132,2 1,0)
  9058   1^^1^1^302 1118^^
  9059   "^DD",200, 200,.132,2 1,1,0)
  9060   This is th e business /office te lephone fo r the new  person.
  9061   "^DD",200, 200,.132," DT")
  9062   2941024
  9063   "^DD",200, 200,.133,0 )
  9064   PHONE #3^F ^^.13;3^K: X[""""!($A (X)=45) X  I $D(X) K: $L(X)>20!( $L(X)<4)!' (X?4.20NP)  X
  9065   "^DD",200, 200,.133,1 ,0)
  9066   ^.1^^0
  9067   "^DD",200, 200,.133,3 )
  9068   Answer mus t be 4-20  characters  in length . Only num eric/punct uation cha racters wi ll be allo wed.
  9069   "^DD",200, 200,.133,2 1,0)
  9070   ^^2^2^3021 118^^^
  9071   "^DD",200, 200,.133,2 1,1,0)
  9072   This is an  alternate  telephone  number wh ere the ne w person m ight also
  9073   "^DD",200, 200,.133,2 1,2,0)
  9074   be reached .
  9075   "^DD",200, 200,.133," DT")
  9076   2941024
  9077   "^DD",200, 200,.134,0 )
  9078   PHONE #4^F ^^.13;4^K: X[""""!($A (X)=45) X  I $D(X) K: $L(X)>20!( $L(X)<4)!' (X?4.20NP)  X
  9079   "^DD",200, 200,.134,1 ,0)
  9080   ^.1^^0
  9081   "^DD",200, 200,.134,3 )
  9082   Answer mus t be 4-20  characters  in length . Only num eric/punct uation cha racters wi ll be allo wed.
  9083   "^DD",200, 200,.134,2 1,0)
  9084   ^^2^2^3021 118^^^
  9085   "^DD",200, 200,.134,2 1,1,0)
  9086   This is an other alte rnate tele phone numb er where t he new per son might
  9087   "^DD",200, 200,.134,2 1,2,0)
  9088   also be re ached.
  9089   "^DD",200, 200,.134," DT")
  9090   2941024
  9091   "^DD",200, 200,.135,0 )
  9092   COMMERCIAL  PHONE^F^^ .13;5^K:$L (X)>20!($L (X)<4)!'(X ?4.20NP) X
  9093   "^DD",200, 200,.135,3 )
  9094   Answer mus t be 4-20  characters  in length . Only num eric/punct uation cha racters wi ll be allo wed.
  9095   "^DD",200, 200,.135,2 1,0)
  9096   ^^1^1^3021 118^^^
  9097   "^DD",200, 200,.135,2 1,1,0)
  9098   This is a  commercial  phone num ber used b y IFCAP.
  9099   "^DD",200, 200,.135," DT")
  9100   2941024
  9101   "^DD",200, 200,.136,0 )
  9102   FAX NUMBER ^F^^.13;6^ K:$L(X)>20 !($L(X)<7) !'(X?4.20N P) X
  9103   "^DD",200, 200,.136,3 )
  9104   Answer mus t be 4-20  characters  in length . Only num eric/punct uation cha racters wi ll be allo wed.
  9105   "^DD",200, 200,.136,2 1,0)
  9106   ^^3^3^3030 107^^^^
  9107   "^DD",200, 200,.136,2 1,1,0)
  9108   This field  holds a p hone numbe r for a FA X machine  for this u ser.
  9109   "^DD",200, 200,.136,2 1,2,0)
  9110   It needs t o be a for mat that c an be unde rstood by  a sending 
  9111   "^DD",200, 200,.136,2 1,3,0)
  9112   MODEM.
  9113   "^DD",200, 200,.136," DT")
  9114   3030107
  9115   "^DD",200, 200,.137,0 )
  9116   VOICE PAGE R^F^^.13;7 ^K:$L(X)>2 0!($L(X)<3 )!'(X?3.20 NP) X
  9117   "^DD",200, 200,.137,3 )
  9118   Answer mus t be 3-20  characters  in length .
  9119   "^DD",200, 200,.137,2 1,0)
  9120   ^^4^4^2941 024^
  9121   "^DD",200, 200,.137,2 1,1,0)
  9122   This field  holds a p hone numbe r for an A NALOG PAGE R that thi s person
  9123   "^DD",200, 200,.137,2 1,2,0)
  9124   carries wi th them.
  9125   "^DD",200, 200,.137,2 1,3,0)
  9126   It needs t o be a for mat that c an be unde rstood by  a sending 
  9127   "^DD",200, 200,.137,2 1,4,0)
  9128   MODEM.
  9129   "^DD",200, 200,.137," DT")
  9130   2950801
  9131   "^DD",200, 200,.138,0 )
  9132   DIGITAL PA GER^F^^.13 ;8^K:$L(X) >20!($L(X) <3)!'(X?3. 20NP) X
  9133   "^DD",200, 200,.138,3 )
  9134   Answer mus t be 3-20  characters  in length .
  9135   "^DD",200, 200,.138,2 1,0)
  9136   ^^4^4^2941 024^
  9137   "^DD",200, 200,.138,2 1,1,0)
  9138   This field  holds a p hone numbe r for a DI GITAL PAGE R that thi s person
  9139   "^DD",200, 200,.138,2 1,2,0)
  9140   carries wi th them.
  9141   "^DD",200, 200,.138,2 1,3,0)
  9142   It needs t o be a for mat that c an be unde rstood by  a sending 
  9143   "^DD",200, 200,.138,2 1,4,0)
  9144   MODEM.
  9145   "^DD",200, 200,.138," DT")
  9146   2950801
  9147   "^DD",200, 200,.141,0 )
  9148   ROOM^F^^.1 4;1^K:$L(X )>30!($L(X )<2) X
  9149   "^DD",200, 200,.141,3 )
  9150   Answer mus t be 2-30  characters  in length .  Where d oes one go  to see yo u.
  9151   "^DD",200, 200,.141,2 1,0)
  9152   ^^1^1^2920 513^^
  9153   "^DD",200, 200,.141,2 1,1,0)
  9154   This is th e room num ber assign ed to the  new person .
  9155   "^DD",200, 200,.141," DT")
  9156   2891026
  9157   "^DD",200, 200,.151,0 )
  9158   EMAIL ADDR ESS^FX^^.1 5;1^K:$L(X )>50!($L(X )<7)!'(X?1 .E1"@"1.E)  X I $D(X)  K:X[","!( X[" ") X
  9159   "^DD",200, 200,.151,3 )
  9160   Enter vali d internet  address i n xxx@doma in format,  7-50 char acters in  length, no  commas or  spaces.
  9161   "^DD",200, 200,.151,2 1,0)
  9162   ^^13^13^29 90225^
  9163   "^DD",200, 200,.151,2 1,1,0)
  9164   This field  contains  the e-mail  address t o which an  outside p erson or
  9165   "^DD",200, 200,.151,2 1,2,0)
  9166   vendor can  send corr espondence .
  9167   "^DD",200, 200,.151,2 1,3,0)
  9168    
  9169   "^DD",200, 200,.151,2 1,4,0)
  9170   (i.e. firs tname.last name@ DOMAIN  or 
  9171   "^DD",200, 200,.151,2 1,5,0)
  9172    lastname. firstname@ forum.va.g ov or
  9173   "^DD",200, 200,.151,2 1,6,0)
  9174    lastname. firstname_ i+@forum. DOMAIN       as in
  9175   "^DD",200, 200,.151,2 1,7,0)
  9176    smith.rob ert_b+@for um. DOMAIN      for Robert  B. Smith  on Forum).
  9177   "^DD",200, 200,.151,2 1,8,0)
  9178    
  9179   "^DD",200, 200,.151,2 1,9,0)
  9180   (* Note: p eriod repl aces comma  in lastna me.firstna me syntax,  underscor e
  9181   "^DD",200, 200,.151,2 1,10,0)
  9182   replaces s pace, and  plus sign  replaces p eriod foll owing midd le initial  for
  9183   "^DD",200, 200,.151,2 1,11,0)
  9184   VISTA Mail Man addres ses.)
  9185   "^DD",200, 200,.151,2 1,12,0)
  9186    
  9187   "^DD",200, 200,.151,2 1,13,0)
  9188   This addre ss may app ear on doc uments goi ng to vend ors.
  9189   "^DD",200, 200,.151," DT")
  9190   2990219
  9191   "^DD",200, 200,1,0)
  9192   INITIAL^F^ ^0;2^K:X[" """!($A(X) =45) X I $ D(X) K:X[" """!(X'?.A NP)!(X<0)  X I $D(X)  K:$L(X)>5! ($L(X)<2)! '(X'?.N) X
  9193   "^DD",200, 200,1,1,0)
  9194   ^.1^^-1
  9195   "^DD",200, 200,1,1,1, 0)
  9196   200^C
  9197   "^DD",200, 200,1,1,1, 1)
  9198   S ^VA(200, "C",$E(X,1 ,30),DA)=" "
  9199   "^DD",200, 200,1,1,1, 2)
  9200   K ^VA(200, "C",$E(X,1 ,30),DA)
  9201   "^DD",200, 200,1,3)
  9202   Answer mus t be 2-5 c haracters  in length.
  9203   "^DD",200, 200,1,21,0 )
  9204   ^^2^2^2930 415^^^
  9205   "^DD",200, 200,1,21,1 ,0)
  9206   These are  the initia ls of the  user, whic h may be e ntered for  naming
  9207   "^DD",200, 200,1,21,2 ,0)
  9208   users.
  9209   "^DD",200, 200,1,"AUD IT")
  9210  
  9211   "^DD",200, 200,1,"DT" )
  9212   2950316
  9213   "^DD",200, 200,2,0)
  9214   ACCESS COD E^FXO^^0;3 ^K:X[""""! ($A(X)=45)  X I $D(X)  Q
  9215   "^DD",200, 200,2,.1)
  9216  
  9217   "^DD",200, 200,2,1,0)
  9218   ^.1
  9219   "^DD",200, 200,2,1,1, 0)
  9220   200^A^MUMP S
  9221   "^DD",200, 200,2,1,1, 1)
  9222   S ^VA(200, "A",X,DA)= +$H
  9223   "^DD",200, 200,2,1,1, 2)
  9224   K ^VA(200, "A",X,DA)
  9225   "^DD",200, 200,2,1,1, 3)
  9226   ACCESS COD E lookup
  9227   "^DD",200, 200,2,1,2, 0)
  9228   200^AOLD^M UMPS
  9229   "^DD",200, 200,2,1,2, 1)
  9230   Q
  9231   "^DD",200, 200,2,1,2, 2)
  9232   S ^VA(200, "AOLD",X,D A)=+$H
  9233   "^DD",200, 200,2,1,2, 3)
  9234   OLD ACCESS  CODES
  9235   "^DD",200, 200,2,1,2, "%D",0)
  9236   ^^2^2^2920 513^
  9237   "^DD",200, 200,2,1,2, "%D",1,0)
  9238   This is a  list of us ed ACCESS  CODES that  may not b e used aga in untill
  9239   "^DD",200, 200,2,1,2, "%D",2,0)
  9240   the OLD AC CESS CODE  PURGE opti on is run.
  9241   "^DD",200, 200,2,1,3, 0)
  9242   ^^TRIGGER^ 200^202.04
  9243   "^DD",200, 200,2,1,3, 1)
  9244   K DIV S DI V=X,D0=DA, DIV(0)=D0  S Y(1)=$S( $D(^VA(200 ,D0,1.1)): ^(1.1),1:" ") S X=$P( Y(1),U,4), X=X S DIU= X K Y S X= DIV N %I,% H,% D NOW^ %DTC S DIH =$G(^VA(20 0,DIV(0),1 .1)),DIV=X  S $P(^(1. 1),U,4)=DI V,DIH=200, DIG=202.04  D ^DICR
  9245   "^DD",200, 200,2,1,3, 2)
  9246   Q
  9247   "^DD",200, 200,2,1,3, 3)
  9248   DO NOT DEL ETE
  9249   "^DD",200, 200,2,1,3, "%D",0)
  9250   ^^3^3^3010 709^
  9251   "^DD",200, 200,2,1,3, "%D",1,0)
  9252   This cross  reference  triggers  the "Entry  Last Edit  Date" fie ld with to days
  9253   "^DD",200, 200,2,1,3, "%D",2,0)
  9254   date.  The  Entry Las t Edit Dat e field is  used to t rack when  changes ar e
  9255   "^DD",200, 200,2,1,3, "%D",3,0)
  9256   made so th at we don' t disable  the accoun t right af ter it is  edited.
  9257   "^DD",200, 200,2,1,3, "CREATE VA LUE")
  9258   TODAY
  9259   "^DD",200, 200,2,1,3, "DELETE VA LUE")
  9260   NO EFFECT
  9261   "^DD",200, 200,2,1,3, "DT")
  9262   3010709
  9263   "^DD",200, 200,2,1,3, "FIELD")
  9264   #202.04
  9265   "^DD",200, 200,2,2)
  9266   S Y(0)=Y S  Y="<Hidde n>"
  9267   "^DD",200, 200,2,2.1)
  9268   S Y="<Hidd en>"
  9269   "^DD",200, 200,2,3)
  9270  
  9271   "^DD",200, 200,2,4)
  9272  
  9273   "^DD",200, 200,2,9)
  9274   ^
  9275   "^DD",200, 200,2,9.2)
  9276   S XMB="XUS  ACCESS CO DE VIOLATI ON",XMY(%) =1 D ^XMB  K X,XMB
  9277   "^DD",200, 200,2,21,0 )
  9278   ^^6^6^2920 513^^^^
  9279   "^DD",200, 200,2,21,1 ,0)
  9280   This is a  unique cod e to ident ify a user  to the sy stem.
  9281   "^DD",200, 200,2,21,2 ,0)
  9282   This code  is hashed  so that it  can't be  looked up  to find ou t the code .
  9283   "^DD",200, 200,2,21,3 ,0)
  9284   The access  code will  appear as  a string  of numbers , but must  be entere d
  9285   "^DD",200, 200,2,21,4 ,0)
  9286   as a separ ate entry.   Users wh o have no  access cod e will not  receive
  9287   "^DD",200, 200,2,21,5 ,0)
  9288   mail.
  9289   "^DD",200, 200,2,21,6 ,0)
  9290   *** This f ield shoul d never be  edited di rectly - d o not remo ve WRITE A CCESS!
  9291   "^DD",200, 200,2,"AUD IT")
  9292  
  9293   "^DD",200, 200,2,"DT" )
  9294   3010709
  9295   "^DD",200, 200,2.1,0)
  9296   Want to ed it ACCESS  CODE (Y/N) ^FX^^.1;10 ^D ACCED^X US2
  9297   "^DD",200, 200,2.1,.1 )
  9298   ACCESS COD E
  9299   "^DD",200, 200,2.1,3)
  9300   Enter 'Y'  if you wis h to edit  at this ti me, 'N' ot herwise.
  9301   "^DD",200, 200,2.1,21 ,0)
  9302   ^^2^2^2920 513^^^^
  9303   "^DD",200, 200,2.1,21 ,1,0)
  9304   Entering a  YES to th is field c alls the K ERNEL rout ine
  9305   "^DD",200, 200,2.1,21 ,2,0)
  9306   for enteri ng ACCESS  codes. No  data is st ored for t his field.
  9307   "^DD",200, 200,2.1,"A UDIT")
  9308  
  9309   "^DD",200, 200,2.2,0)
  9310   DATE ACCES S CODE LAS T CHANGED^ CD^^ ; ^S  X=$P(^VA(2 00,D0,0),U ,3) I X]"" ,$D(^VA(20 0,"A",X,D0 )),^(D0) S  %H=+^(D0)  D YMD^%DT C
  9311   "^DD",200, 200,2.2,9)
  9312   ^
  9313   "^DD",200, 200,2.2,9. 01)
  9314  
  9315   "^DD",200, 200,2.2,9. 1)
  9316   S X=$P(^VA (200,D0,0) ,U,3) I X] "",$D(^VA( 200,"A",X, D0)) S %H= +^(D0) D Y MD^%DTC
  9317   "^DD",200, 200,2.2,21 ,0)
  9318   ^^2^2^2920 513^^^
  9319   "^DD",200, 200,2.2,21 ,1,0)
  9320   This is th e date the  ACCESS CO DE was las t changed.  It is use d
  9321   "^DD",200, 200,2.2,21 ,2,0)
  9322   to see tha t codes ar e changed  on a regul ar basis.
  9323   "^DD",200, 200,3,0)
  9324   FILE MANAG ER ACCESS  CODE^FXa^^ 0;4^K:X["" ""!(X["@") !($A(X)=45 ) X I $D(X ) K:$L(X)> 15!($L(X)< 1) X
  9325   "^DD",200, 200,3,.1)
  9326   DUZ(0)
  9327   "^DD",200, 200,3,1,0)
  9328   ^.1^^0
  9329   "^DD",200, 200,3,3)
  9330   ANSWER MUS T BE 1-15  CHARACTERS  IN LENGTH
  9331   "^DD",200, 200,3,10)
  9332   LOGON PROG RAM
  9333   "^DD",200, 200,3,11,0 )
  9334   ^.2LAP^^
  9335   "^DD",200, 200,3,21,0 )
  9336   ^^2^2^2920 513^^^^
  9337   "^DD",200, 200,3,21,1 ,0)
  9338   This is th e string t hat is put  in DUZ(0)  for use b y fileman
  9339   "^DD",200, 200,3,21,2 ,0)
  9340   to check f ile and fi eld access .
  9341   "^DD",200, 200,3,"AUD IT")
  9342   e
  9343   "^DD",200, 200,3,"DT" )
  9344   2890418
  9345   "^DD",200, 200,4,0)
  9346   SEX^Sa^M:M ALE;F:FEMA LE;^1;2^Q
  9347   "^DD",200, 200,4,1,0)
  9348   ^.1
  9349   "^DD",200, 200,4,1,1, 0)
  9350   200^AMPI4^ MUMPS
  9351   "^DD",200, 200,4,1,1, 1)
  9352   D XREF^XUM PI(DA)
  9353   "^DD",200, 200,4,1,1, 2)
  9354   D XREF^XUM PI(DA)
  9355   "^DD",200, 200,4,1,1, "%D",0)
  9356   ^^4^4^3100 903^
  9357   "^DD",200, 200,4,1,1, "%D",1,0)
  9358   This cross  reference  sets the  Requires T ransmissio n (#902) f ield if th e
  9359   "^DD",200, 200,4,1,1, "%D",2,0)
  9360   enumeratio n process  has begun  for this f ile.  Sett ing that f ield will
  9361   "^DD",200, 200,4,1,1, "%D",3,0)
  9362   result in  a VPID bei ng assigne d or an up date messa ge being s ent to the  MPI
  9363   "^DD",200, 200,4,1,1, "%D",4,0)
  9364   for this c hange in d ata.
  9365   "^DD",200, 200,4,1,1, "DT")
  9366   3100805
  9367   "^DD",200, 200,4,21,0 )
  9368   ^^1^1^2920 513^^
  9369   "^DD",200, 200,4,21,1 ,0)
  9370   This is th e gender f or the new  person.
  9371   "^DD",200, 200,4,"AUD IT")
  9372   y
  9373   "^DD",200, 200,4,"DT" )
  9374   3100805
  9375   "^DD",200, 200,5,0)
  9376   DOB^Da^^1; 3^S %DT="E X" D ^%DT  S X=Y K:Y< 1 X
  9377   "^DD",200, 200,5,1,0)
  9378   ^.1
  9379   "^DD",200, 200,5,1,1, 0)
  9380   200^AMPI5^ MUMPS
  9381   "^DD",200, 200,5,1,1, 1)
  9382   D XREF^XUM PI(DA)
  9383   "^DD",200, 200,5,1,1, 2)
  9384   D XREF^XUM PI(DA)
  9385   "^DD",200, 200,5,1,1, "%D",0)
  9386   ^^4^4^3100 903^
  9387   "^DD",200, 200,5,1,1, "%D",1,0)
  9388   This cross  reference  sets the  Requires T ransmissio n (#902) f ield if th e
  9389   "^DD",200, 200,5,1,1, "%D",2,0)
  9390   enumeratio n process  has begun  for this f ile.  Sett ing that f ield will
  9391   "^DD",200, 200,5,1,1, "%D",3,0)
  9392   result in  a VPID bei ng assigne d or an up date messa ge being s ent to the  MPI
  9393   "^DD",200, 200,5,1,1, "%D",4,0)
  9394   for this c hange in d ata.
  9395   "^DD",200, 200,5,1,1, "DT")
  9396   3100805
  9397   "^DD",200, 200,5,21,0 )
  9398   ^^1^1^2920 513^^
  9399   "^DD",200, 200,5,21,1 ,0)
  9400   This is th e date of  birth of t he new per son.
  9401   "^DD",200, 200,5,"AUD IT")
  9402   y
  9403   "^DD",200, 200,5,"DT" )
  9404   3100805
  9405   "^DD",200, 200,7,0)
  9406   DISUSER^S^ 0:NO;1:YES ;^0;7^Q
  9407   "^DD",200, 200,7,1,0)
  9408   ^.1
  9409   "^DD",200, 200,7,1,1, 0)
  9410   ^^TRIGGER^ 200^202.04
  9411   "^DD",200, 200,7,1,1, 1)
  9412   K DIV S DI V=X,D0=DA, DIV(0)=D0  S Y(1)=$S( $D(^VA(200 ,D0,1.1)): ^(1.1),1:" ") S X=$P( Y(1),U,4), X=X S DIU= X K Y S X= DIV N %I,% H,% D NOW^ %DTC S DIH =$G(^VA(20 0,DIV(0),1 .1)),DIV=X  S $P(^(1. 1),U,4)=DI V,DIH=200, DIG=202.04  D ^DICR
  9413   "^DD",200, 200,7,1,1, 2)
  9414   K DIV S DI V=X,D0=DA, DIV(0)=D0  S Y(1)=$S( $D(^VA(200 ,D0,1.1)): ^(1.1),1:" ") S X=$P( Y(1),U,4), X=X S DIU= X K Y S X= DIV N %I,% H,% D NOW^ %DTC S DIH =$G(^VA(20 0,DIV(0),1 .1)),DIV=X  S $P(^(1. 1),U,4)=DI V,DIH=200, DIG=202.04  D ^DICR
  9415   "^DD",200, 200,7,1,1, "%D",0)
  9416   ^.101^3^3^ 3050915^^^
  9417   "^DD",200, 200,7,1,1, "%D",1,0)
  9418   This cross  reference  sets the  todays dat e into fie ld 202.04  to keep th e
  9419   "^DD",200, 200,7,1,1, "%D",2,0)
  9420   XUAUTODEAC TIVATE fro m setting  the DISUSE R flag aft er being c leared if  the
  9421   "^DD",200, 200,7,1,1, "%D",3,0)
  9422   user doesn 't sign-on  that day.
  9423   "^DD",200, 200,7,1,1, "CREATE VA LUE")
  9424   TODAY
  9425   "^DD",200, 200,7,1,1, "DELETE VA LUE")
  9426   TODAY
  9427   "^DD",200, 200,7,1,1, "DT")
  9428   3020213
  9429   "^DD",200, 200,7,1,1, "FIELD")
  9430   #202.04
  9431   "^DD",200, 200,7,1,2, 0)
  9432   ^^BULLETIN  MESSAGE
  9433   "^DD",200, 200,7,1,2, 1)
  9434   S Y(0)=X,D 0=DA X "N  DIIND F DI IND=1.001: .001 Q:$D( ^DD(200,7, 1,2,DIIND) )[0  X ^(D IIND)" K X MY S XMB=" DISUSER US ER" D ^XMB :$D(^XMB(3 .6,"B",XMB )) K Y,XMB
  9435   "^DD",200, 200,7,1,2, 1.001)
  9436   S X=Y(0) S  Y(1)=$S($ D(^VA(200, D0,0)):^(0 ),1:"") S  X=$P(Y(1), U,1) S XMB (1)=X
  9437   "^DD",200, 200,7,1,2, 2)
  9438   Q
  9439   "^DD",200, 200,7,1,2, "CREATE PA RAMETER #1 ")
  9440   NAME
  9441   "^DD",200, 200,7,1,2, "CREATE VA LUE")
  9442   DISUSER US ER
  9443   "^DD",200, 200,7,1,2, "DELETE VA LUE")
  9444   NO EFFECT
  9445   "^DD",200, 200,7,1,2, "DT")
  9446   3050915
  9447   "^DD",200, 200,7,3)
  9448   Enter YES  to disable  this user  from logi n-on to th e system.
  9449   "^DD",200, 200,7,21,0 )
  9450   ^^7^7^2940 419^
  9451   "^DD",200, 200,7,21,1 ,0)
  9452   This field , if set t o YES (1),  marks a u ser that i s not allo wed to
  9453   "^DD",200, 200,7,21,2 ,0)
  9454   log on to  this syste m.  It wil l leave al l Menus, K eys and ot her attrib utes
  9455   "^DD",200, 200,7,21,3 ,0)
  9456   exabled fo r the user .
  9457   "^DD",200, 200,7,21,4 ,0)
  9458   An example  would be  an externa l support  person
  9459   "^DD",200, 200,7,21,5 ,0)
  9460   that you o nly want t o be able  to log on  to your sy stem when  you are
  9461   "^DD",200, 200,7,21,6 ,0)
  9462   monitoring  them.  Se tting this  field wou ld prevent  them from  loging
  9463   "^DD",200, 200,7,21,7 ,0)
  9464   on to the  system unt ill you cl eared the  field.
  9465   "^DD",200, 200,7,"DT" )
  9466   3050915
  9467   "^DD",200, 200,7.2,0)
  9468   VERIFY COD E never ex pires^*S^0 :No;1:Yes; ^0;8^Q
  9469   "^DD",200, 200,7.2,5, 1,0)
  9470   200^9.2^1
  9471   "^DD",200, 200,7.2,12 )
  9472   Only perso ns with th e proper k ey can set  this fiel d.
  9473   "^DD",200, 200,7.2,12 .1)
  9474   S DIC("S") ="I Y&$D(^ XUSEC(""XU MGR"",DUZ) )"
  9475   "^DD",200, 200,7.2,21 ,0)
  9476   ^^6^6^3010 330^
  9477   "^DD",200, 200,7.2,21 ,1,0)
  9478   This field  will cont rol if the  users VER IFY code w ill expire  at the
  9479   "^DD",200, 200,7.2,21 ,2,0)
  9480   interval s et by the  Kernel Sys tem Parame ter LIFETI ME OF VERI FY CODE.
  9481   "^DD",200, 200,7.2,21 ,3,0)
  9482   This field  should on ly be used  for acces s to the V istA syste m from oth er
  9483   "^DD",200, 200,7.2,21 ,4,0)
  9484   systems ma king conne ction with  the RPCBr oker and h ave very c ontrolled
  9485   "^DD",200, 200,7.2,21 ,5,0)
  9486   access.
  9487   "^DD",200, 200,7.2,21 ,6,0)
  9488   Only perso ns with th e XUMGR ke y are allo wed to set  this flag .
  9489   "^DD",200, 200,7.2,"D T")
  9490   3010330
  9491   "^DD",200, 200,8,0)
  9492   TITLE^P3.1 ^DIC(3.1,^ 0;9^Q
  9493   "^DD",200, 200,8,1,0)
  9494   ^.1^^0
  9495   "^DD",200, 200,8,3)
  9496  
  9497   "^DD",200, 200,8,21,0 )
  9498   ^^1^1^2920 513^^
  9499   "^DD",200, 200,8,21,1 ,0)
  9500   This is th e title fo r the new  person.
  9501   "^DD",200, 200,8,"DT" )
  9502   2890418
  9503   "^DD",200, 200,9,0)
  9504   SSN^FXa^^1 ;9^K:X[""" "!($A(X)=4 5) X I $D( X) K:$L(X) >9!($L(X)< 9)!'(X?9N)  X I $D(X)  S Y=$O(^V A(200,"SSN ",X,0)) I  Y>0,$D(^VA (200,Y,0))  S DDH=2,D DH(1,"T")= "",DDH(2," T")="  Alr eady used  by "_$P(^( 0),"^",1)  K X Q
  9505   "^DD",200, 200,9,1,0)
  9506   ^.1
  9507   "^DD",200, 200,9,1,1, 0)
  9508   200^BS55^M UMPS
  9509   "^DD",200, 200,9,1,1, 1)
  9510   S ^VA(200, "BS5",$E(^ VA(200,DA, 0),1)_$E(X ,6,9),DA)= ""
  9511   "^DD",200, 200,9,1,1, 2)
  9512   K ^VA(200, "BS5",$E(^ VA(200,DA, 0),1)_$E(X ,6,9),DA)
  9513   "^DD",200, 200,9,1,1, "%D",0)
  9514   ^^2^2^2920 513^
  9515   "^DD",200, 200,9,1,1, "%D",1,0)
  9516   This is th e 'BS5' X- ref on the  SSN field .
  9517   "^DD",200, 200,9,1,1, "%D",2,0)
  9518   See the 'B S5' X-ref  on the nam e field.
  9519   "^DD",200, 200,9,1,2, 0)
  9520   200^SSN
  9521   "^DD",200, 200,9,1,2, 1)
  9522   S ^VA(200, "SSN",$E(X ,1,30),DA) =""
  9523   "^DD",200, 200,9,1,2, 2)
  9524   K ^VA(200, "SSN",$E(X ,1,30),DA)
  9525   "^DD",200, 200,9,1,3, 0)
  9526   200^AMPI9^ MUMPS
  9527   "^DD",200, 200,9,1,3, 1)
  9528   D XREF^XUM PI(DA)
  9529   "^DD",200, 200,9,1,3, 2)
  9530   D XREF^XUM PI(DA)
  9531   "^DD",200, 200,9,1,3, "%D",0)
  9532   ^^4^4^3100 903^
  9533   "^DD",200, 200,9,1,3, "%D",1,0)
  9534   This cross  reference  sets the  Requires T ransmissio n (#902) f ield if th e
  9535   "^DD",200, 200,9,1,3, "%D",2,0)
  9536   enumeratio n process  has begun  for this f ile.  Sett ing that f ield will
  9537   "^DD",200, 200,9,1,3, "%D",3,0)
  9538   result in  a VPID bei ng assigne d or an up date messa ge being s ent to the  MPI
  9539   "^DD",200, 200,9,1,3, "%D",4,0)
  9540   for this c hange in d ata.
  9541   "^DD",200, 200,9,1,3, "DT")
  9542   3100805
  9543   "^DD",200, 200,9,1,4, 0)
  9544   200^BS^MUM PS
  9545   "^DD",200, 200,9,1,4, 1)
  9546   S ^VA(200, "BS",$E(X, 6,9),DA)=" "
  9547   "^DD",200, 200,9,1,4, 2)
  9548   K ^VA(200, "BS",$E(X, 6,9),DA)
  9549   "^DD",200, 200,9,1,4, "%D",0)
  9550   ^^1^1^2920 513^
  9551   "^DD",200, 200,9,1,4, "%D",1,0)
  9552   This is a  X-ref of t he last 4  of the SSN .
  9553   "^DD",200, 200,9,1,5, 0)
  9554   200^AJ^MUM PS
  9555   "^DD",200, 200,9,1,5, 1)
  9556   S %=X,X="P RSD450" X  ^%ZOSF("TE ST") K X I  $T S X=%  D SET450^P RSD450
  9557   "^DD",200, 200,9,1,5, 2)
  9558   S %=X,X="P RSD450" X  ^%ZOSF("TE ST") K X I  $T S X=%  D KILL450^ PRSD450
  9559   "^DD",200, 200,9,1,5, "%D",0)
  9560   ^^3^3^2950 428^^^^
  9561   "^DD",200, 200,9,1,5, "%D",1,0)
  9562   This cross -reference  will set  or kill th e NEW PERS ON pointer  in the PA ID
  9563   "^DD",200, 200,9,1,5, "%D",2,0)
  9564   EMPLOYEE f ile and th e PAID EMP LOYEE poin ter in the  NEW PERSO N file whe never
  9565   "^DD",200, 200,9,1,5, "%D",3,0)
  9566   the SSN va lue is cha nged or de leted.
  9567   "^DD",200, 200,9,1,5, "DT")
  9568   2950426
  9569   "^DD",200, 200,9,3)
  9570   ANSWER MUS T BE 9 CHA RACTERS IN  LENGTH
  9571   "^DD",200, 200,9,21,0 )
  9572   ^^1^1^2920 513^^
  9573   "^DD",200, 200,9,21,1 ,0)
  9574   This is th e social s ecurity nu mber of th e new pers on.
  9575   "^DD",200, 200,9,"AUD IT")
  9576   y
  9577   "^DD",200, 200,9,"DT" )
  9578   3100805
  9579   "^DD",200, 200,9.2,0)
  9580   TERMINATIO N DATE^DXa ^^0;11^S % DT="EX" D  ^%DT S X=Y  K:Y<1 X
  9581   "^DD",200, 200,9.2,1, 0)
  9582   ^.1
  9583   "^DD",200, 200,9.2,1, 1,0)
  9584   ^^TRIGGER^ 200^7.2
  9585   "^DD",200, 200,9.2,1, 1,1)
  9586   K DIV S DI V=X,D0=DA, DIV(0)=D0  S Y(1)=$S( $D(^VA(200 ,D0,0)):^( 0),1:"") S  X=$P(Y(1) ,U,8),X=X  S DIU=X K  Y S X="" S  DIH=$G(^V A(200,DIV( 0),0)),DIV =X S $P(^( 0),U,8)=DI V,DIH=200, DIG=7.2 D  ^DICR
  9587   "^DD",200, 200,9.2,1, 1,2)
  9588   Q
  9589   "^DD",200, 200,9.2,1, 1,3)
  9590   Don't Dele te
  9591   "^DD",200, 200,9.2,1, 1,"%D",0)
  9592   ^^2^2^3010 131^
  9593   "^DD",200, 200,9.2,1, 1,"%D",1,0 )
  9594   This trige r will del ete the "V ERIFY CODE  never exp ires" fiel d when a
  9595   "^DD",200, 200,9.2,1, 1,"%D",2,0 )
  9596   terminatio n date is  entered.
  9597   "^DD",200, 200,9.2,1, 1,"CREATE  VALUE")
  9598   @
  9599   "^DD",200, 200,9.2,1, 1,"DELETE  VALUE")
  9600   NO EFFECT
  9601   "^DD",200, 200,9.2,1, 1,"DT")
  9602   3010131
  9603   "^DD",200, 200,9.2,1, 1,"FIELD")
  9604   VERIFY COD E never ex pires
  9605   "^DD",200, 200,9.2,1, 2,0)
  9606   ^^TRIGGER^ 200^202.04
  9607   "^DD",200, 200,9.2,1, 2,1)
  9608   Q
  9609   "^DD",200, 200,9.2,1, 2,2)
  9610   K DIV S DI V=X,D0=DA, DIV(0)=D0  S Y(1)=$S( $D(^VA(200 ,D0,1.1)): ^(1.1),1:" ") S X=$P( Y(1),U,4), X=X S DIU= X K Y S X= DIV N %I,% H,% D NOW^ %DTC S DIH =$G(^VA(20 0,DIV(0),1 .1)),DIV=X  S $P(^(1. 1),U,4)=DI V,DIH=200, DIG=202.04  D ^DICR
  9611   "^DD",200, 200,9.2,1, 2,3)
  9612   Don't Dele te
  9613   "^DD",200, 200,9.2,1, 2,"%D",0)
  9614   ^^3^3^3010 927^
  9615   "^DD",200, 200,9.2,1, 2,"%D",1,0 )
  9616   This cross  reference  triggers  the "Entry  Last Edit  Date" fie ld with to days
  9617   "^DD",200, 200,9.2,1, 2,"%D",2,0 )
  9618   date.  The  Entry Las t Edit Dat e field is  used to t rack when  changes ar e
  9619   "^DD",200, 200,9.2,1, 2,"%D",3,0 )
  9620   made so th at we don' t disable  the accoun t right af ter it is  edited.
  9621   "^DD",200, 200,9.2,1, 2,"CREATE  VALUE")
  9622   NO EFFECT
  9623   "^DD",200, 200,9.2,1, 2,"DELETE  VALUE")
  9624   TODAY
  9625   "^DD",200, 200,9.2,1, 2,"DT")
  9626   3010927
  9627   "^DD",200, 200,9.2,1, 2,"FIELD")
  9628   #202.04
  9629   "^DD",200, 200,9.2,1, 3,0)
  9630   ^^BULLETIN  MESSAGE
  9631   "^DD",200, 200,9.2,1, 3,1)
  9632   S Y(0)=X,D 0=DA X "N  DIIND F DI IND=1.001: .001 Q:$D( ^DD(200,9. 2,1,3,DIIN D))[0  X ^ (DIIND)" K  XMY S XMB ="TERMINAT ED USER" D  ^XMB:$D(^ XMB(3.6,"B ",XMB)) K  Y,XMB
  9633   "^DD",200, 200,9.2,1, 3,1.001)
  9634   S X=Y(0) S  Y(1)=$S($ D(^VA(200, D0,0)):^(0 ),1:"") S  X=$P(Y(1), U,1) S XMB (1)=X
  9635   "^DD",200, 200,9.2,1, 3,1.002)
  9636   S X=Y(0) S  Y(1)=$S($ D(^VA(200, D0,0)):^(0 ),1:"") S  X=$P(Y(1), U,11) S Y= X X ^DD("D D") S X=Y  S XMB(2)=X
  9637   "^DD",200, 200,9.2,1, 3,2)
  9638   Q
  9639   "^DD",200, 200,9.2,1, 3,"CREATE  PARAMETER  #1")
  9640   NAME
  9641   "^DD",200, 200,9.2,1, 3,"CREATE  PARAMETER  #2")
  9642   TERMINATIO N DATE
  9643   "^DD",200, 200,9.2,1, 3,"CREATE  VALUE")
  9644   TERMINATED  USER
  9645   "^DD",200, 200,9.2,1, 3,"DELETE  VALUE")
  9646   NO EFFECT
  9647   "^DD",200, 200,9.2,1, 3,"DT")
  9648   3050914
  9649   "^DD",200, 200,9.2,21 ,0)
  9650   ^.001^4^4^ 3040805^^^
  9651   "^DD",200, 200,9.2,21 ,1,0)
  9652   This is th e date aft er which t he compute r will no  longer rec ognize thi s
  9653   "^DD",200, 200,9.2,21 ,2,0)
  9654   user's ACC ESS CODE.
  9655   "^DD",200, 200,9.2,21 ,3,0)
  9656   Once this  date has p assed, whe n the USER  TERMINATE  job runs  it will cl ean
  9657   "^DD",200, 200,9.2,21 ,4,0)
  9658   out this u sers data  based on f lags in th e NEW PERS ON file.
  9659   "^DD",200, 200,9.2,"A UDIT")
  9660   y
  9661   "^DD",200, 200,9.2,"D T")
  9662   3040928
  9663   "^DD",200, 200,9.21,0 )
  9664   DELETE ALL  MAIL ACCE SS^S^y:YES ;n:NO;^0;5 ^Q
  9665   "^DD",200, 200,9.21,. 1)
  9666  
  9667   "^DD",200, 200,9.21,3 )
  9668   When a use r is termi nated you  have the o ption of d eleting al l of their  mail mess ages.  Thi s is recom mended.
  9669   "^DD",200, 200,9.21,2 1,0)
  9670   ^^4^4^2940 809^
  9671   "^DD",200, 200,9.21,2 1,1,0)
  9672   This gives  you the a bility to  purge all  of a user' s mail rel ated
  9673   "^DD",200, 200,9.21,2 1,2,0)
  9674   informatio n. This in cludes Mai l messages , Mail Box es, Mail G roups,
  9675   "^DD",200, 200,9.21,2 1,3,0)
  9676   Surrogate  privlages  when that  user is te rminated.
  9677   "^DD",200, 200,9.21,2 1,4,0)
  9678   This is re comended.
  9679   "^DD",200, 200,9.21," DT")
  9680   2940809
  9681   "^DD",200, 200,9.22,0 )
  9682   DELETE KEY S AT TERMI NATION^S^y :YES;n:NO; ^0;6^Q
  9683   "^DD",200, 200,9.22,. 1)
  9684  
  9685   "^DD",200, 200,9.22,3 )
  9686   When a use r is termi nated you  have the o ption of d eleting al l of their  security  keys.  Thi s is recom mended.
  9687   "^DD",200, 200,9.22,2 1,0)
  9688   ^^3^3^2940 809^
  9689   "^DD",200, 200,9.22,2 1,1,0)
  9690   This gives  you the a bility to  delete all  of a user 's securit y
  9691   "^DD",200, 200,9.22,2 1,2,0)
  9692   keys, and  delagated  keys when  the user i s terminat ed.
  9693   "^DD",200, 200,9.22,2 1,3,0)
  9694   This is re comended.
  9695   "^DD",200, 200,9.3,0)
  9696   TERMINAL T YPE LAST U SED^*P3.2' ^%ZIS(2,^1 .2;1^S DIC ("S")="I $ P(^(0),U,2 )" D ^DIC  K DIC S DI C=DIE,X=+Y  K:Y<0 X
  9697   "^DD",200, 200,9.3,9)
  9698   ^
  9699   "^DD",200, 200,9.3,9. 01)
  9700  
  9701   "^DD",200, 200,9.3,9. 1)
  9702   S X=$S($D( ^XMB(3.7,D 0,.2)):^(. 2),1:-1),X =$S($D(^%Z IS(2,+X,0) ):$P(^(0), U,1),1:"")
  9703   "^DD",200, 200,9.3,12 )
  9704   Check the  SELECTABLE  at signon  flag
  9705   "^DD",200, 200,9.3,12 .1)
  9706   S DIC("S") ="I $P(^(0 ),U,2)"
  9707   "^DD",200, 200,9.3,21 ,0)
  9708   ^^2^2^2920 513^^
  9709   "^DD",200, 200,9.3,21 ,1,0)
  9710   This field  holds a p ointer to  the last t erminal ty pe the use r selected
  9711   "^DD",200, 200,9.3,21 ,2,0)
  9712   at sign-on  or in edi t user cha r.
  9713   "^DD",200, 200,9.3,23 ,0)
  9714   ^^3^3^2910 322^
  9715   "^DD",200, 200,9.3,23 ,1,0)
  9716   This field  is set in  TT^XUS3 t hen the us er selects  a Termina l type
  9717   "^DD",200, 200,9.3,23 ,2,0)
  9718   at sign-on .  It is u sed as the  default t erminal ty pe for the  user
  9719   "^DD",200, 200,9.3,23 ,3,0)
  9720   if not ask ed.
  9721   "^DD",200, 200,9.3,"D T")
  9722   2910322
  9723   "^DD",200, 200,9.4,0)
  9724   Terminatio n Reason^F ^^0;13^K:$ L(X)>45!($ L(X)<2) X
  9725   "^DD",200, 200,9.4,3)
  9726   Answer mus t be 2-45  characters  in length .
  9727   "^DD",200, 200,9.4,21 ,0)
  9728   ^^2^2^3010 131^
  9729   "^DD",200, 200,9.4,21 ,1,0)
  9730   This field  holds a s hort descr iption of  why the us er has bee n terminat ed
  9731   "^DD",200, 200,9.4,21 ,2,0)
  9732   or has DIS USER flag  set.
  9733   "^DD",200, 200,9.4,"D T")
  9734   3010131
  9735   "^DD",200, 200,9.5,0)
  9736   USER CLASS ^200.07P^^ USC3;0
  9737   "^DD",200, 200,9.5,"D T")
  9738   3041104
  9739   "^DD",200, 200,10,0)
  9740   ALIAS^200. 04^^3;0
  9741   "^DD",200, 200,10,21, 0)
  9742   ^^1^1^2920 513^^^^
  9743   "^DD",200, 200,10,21, 1,0)
  9744   Other name s used by  this new p erson.
  9745   "^DD",200, 200,10.1,0 )
  9746   NAME COMPO NENTS^RP20 'I^VA(20,^ 3.1;1^Q
  9747   "^DD",200, 200,10.1,3 )
  9748   Answer '?? ' for more  help.
  9749   "^DD",200, 200,10.1,2 1,0)
  9750   ^^2^2^2991 129^
  9751   "^DD",200, 200,10.1,2 1,1,0)
  9752   Answer wit h the entr y in the N AME COMPON ENTS file  that conta ins the
  9753   "^DD",200, 200,10.1,2 1,2,0)
  9754   components  of the pe rson's nam e.
  9755   "^DD",200, 200,10.1," DT")
  9756   2991129
  9757   "^DD",200, 200,10.6,0 )
  9758   DEGREE^F^^ 3.1;6^K:$L (X)>10!($L (X)<1) X
  9759   "^DD",200, 200,10.6,3 )
  9760   Answer mus t be 1-10  characters  in length .
  9761   "^DD",200, 200,10.6,2 1,0)
  9762   ^^2^2^2991 201^
  9763   "^DD",200, 200,10.6,2 1,1,0)
  9764   This field  holds any  academic  or profess ional degr ee that ha ve been ea rned
  9765   "^DD",200, 200,10.6,2 1,2,0)
  9766   by the use r. This wo uld be thi ngs like B S, BA, MD,  and PHD.
  9767   "^DD",200, 200,10.6," DT")
  9768   3000105
  9769   "^DD",200, 200,11,0)
  9770   VERIFY COD E^FXOa^^.1 ;2^Q
  9771   "^DD",200, 200,11,1,0 )
  9772   ^.1
  9773   "^DD",200, 200,11,1,1 ,0)
  9774   ^^TRIGGER^ 200^11.2
  9775   "^DD",200, 200,11,1,1 ,1)
  9776   K DIV S DI V=X,D0=DA, DIV(0)=D0  S Y(1)=$S( $D(^VA(200 ,D0,.1)):^ (.1),1:"")  S X=$P(Y( 1),U,1),X= X S DIU=X  K Y S X=DI V S X=$S(D 0=DUZ:$H,1 :"60000,1" ) S DIH=$G (^VA(200,D IV(0),.1)) ,DIV=X S $ P(^(.1),U, 1)=DIV,DIH =200,DIG=1 1.2 D ^DIC R
  9777   "^DD",200, 200,11,1,1 ,1.4)
  9778   S DIH=$S($ D(^VA(200, DIV(0),.1) ):^(.1),1: ""),DIV=X  S %=$P(DIH ,U,2,999), DIU=$P(DIH ,U,1),^(.1 )=DIV_$S(% ]"":U_%,1: ""),DIH=20 0,DIG=11.2  D ^DICR:$ O(^DD(DIH, DIG,1,0))> 0
  9779   "^DD",200, 200,11,1,1 ,2)
  9780   Q
  9781   "^DD",200, 200,11,1,1 ,3)
  9782   Triggers t he DATE VE RIFY CODE  LAST CHANG ED field.
  9783   "^DD",200, 200,11,1,1 ,"CREATE V ALUE")
  9784   $S(D0=DUZ: $H,1:"6000 0,1")
  9785   "^DD",200, 200,11,1,1 ,"DELETE V ALUE")
  9786   NO EFFECT
  9787   "^DD",200, 200,11,1,1 ,"DT")
  9788   3060511
  9789   "^DD",200, 200,11,1,1 ,"FIELD")
  9790   DATE VERIF Y CODE LAS T CHANGED
  9791   "^DD",200, 200,11,1,2 ,0)
  9792   200^VOLD^M UMPS
  9793   "^DD",200, 200,11,1,2 ,1)
  9794   Q
  9795   "^DD",200, 200,11,1,2 ,2)
  9796   S ^VA(200, DA,"VOLD", X)=+$H
  9797   "^DD",200, 200,11,1,2 ,"%D",0)
  9798   ^^3^3^2920 513^
  9799   "^DD",200, 200,11,1,2 ,"%D",1,0)
  9800   This build s a list o f old VERI FY CODEs t hat this u ser has ha d in the p ast.
  9801   "^DD",200, 200,11,1,2 ,"%D",2,0)
  9802   It is clea ned  out w ith the sa me option  the purges  the old
  9803   "^DD",200, 200,11,1,2 ,"%D",3,0)
  9804   access cod e X-ref.
  9805   "^DD",200, 200,11,2)
  9806   S Y(0)=Y S  Y="<Hidde n>"
  9807   "^DD",200, 200,11,2.1 )
  9808   S Y="<Hidd en>"
  9809   "^DD",200, 200,11,3)
  9810  
  9811   "^DD",200, 200,11,9)
  9812   ^
  9813   "^DD",200, 200,11,21, 0)
  9814   ^^8^8^2920 513^^^^
  9815   "^DD",200, 200,11,21, 1,0)
  9816   This is th e code tha t is used  to verify  that the A CCESS CODE  was not
  9817   "^DD",200, 200,11,21, 2,0)
  9818   found by a ccident.
  9819   "^DD",200, 200,11,21, 3,0)
  9820   It may be  entered at  logon tim e immediat ely after  the ACCESS  CODE
  9821   "^DD",200, 200,11,21, 4,0)
  9822   by typing  a semicolo n, then th e VERIFY C ODE.
  9823   "^DD",200, 200,11,21, 5,0)
  9824  
  9825   "^DD",200, 200,11,21, 6,0)
  9826   Verify cod es may be  changed by  the user  with the C HANGE USER  CHARACTER ISTICS
  9827   "^DD",200, 200,11,21, 7,0)
  9828   option.  T he kernel  site param eter field  LIFETIME  OF VERIFY  CODE force s
  9829   "^DD",200, 200,11,21, 8,0)
  9830   the user t o periodic ally enter  a new ver ify code.
  9831   "^DD",200, 200,11,"AU DIT")
  9832   y
  9833   "^DD",200, 200,11,"DT ")
  9834   3060511
  9835   "^DD",200, 200,11.1,0 )
  9836   Want to ed it VERIFY  CODE (Y/N) ^FX^^.1;11 ^D VERED^X US2
  9837   "^DD",200, 200,11.1,. 1)
  9838   VERIFY COD E
  9839   "^DD",200, 200,11.1,3 )
  9840   Enter 'Y'  if you wis h to edit  at this ti me, 'N' ot herwise.
  9841   "^DD",200, 200,11.1,2 1,0)
  9842   ^^2^2^2920 513^^^
  9843   "^DD",200, 200,11.1,2 1,1,0)
  9844   Entering a  YES to th is field c alls the K ERNEL rout ine
  9845   "^DD",200, 200,11.1,2 1,2,0)
  9846   for enteri ng VERIFY  codes. No  data is st ored for t his field.
  9847   "^DD",200, 200,11.2,0 )
  9848   DATE VERIF Y CODE LAS T CHANGED^ FOI^^.1;1^
  9849   "^DD",200, 200,11.2,2 )
  9850   S Y(0)=Y S  %H=+Y D Y MD^%DTC S  Y=X X ^DD( "DD")
  9851   "^DD",200, 200,11.2,2 .1)
  9852   S %H=+Y D  YMD^%DTC S  Y=X X ^DD ("DD")
  9853   "^DD",200, 200,11.2,5 ,1,0)
  9854   200^11^1
  9855   "^DD",200, 200,11.2,9 )
  9856   ^
  9857   "^DD",200, 200,11.2,2 1,0)
  9858   ^^2^2^2920 513^^^^
  9859   "^DD",200, 200,11.2,2 1,1,0)
  9860   This field  is trigge red by a c hange in t he VERIFY  CODE.  It  is used
  9861   "^DD",200, 200,11.2,2 1,2,0)
  9862   to determi ne when th e USER mus t be notif ied to cha nge their  code.
  9863   "^DD",200, 200,11.6,0 )
  9864   ALLOW ARA  ACCESS^S^0 :NO;1:YES; ^.1;6^Q
  9865   "^DD",200, 200,11.6,3 )
  9866   Do you wan t to allow  this USER  to have A RA access?
  9867   "^DD",200, 200,11.6,2 1,0)
  9868   ^^1^1^2950 317^
  9869   "^DD",200, 200,11.6,2 1,1,0)
  9870   This field  is for a  control th at is unde r developm ent.
  9871   "^DD",200, 200,11.6," DT")
  9872   2940506
  9873   "^DD",200, 200,11.7,0 )
  9874   ARA VALUE^ F^^.1;7^K: X[""""!($A (X)=45) X  I $D(X) K: $L(X)>50!( $L(X)<20)  X
  9875   "^DD",200, 200,11.7,1 ,0)
  9876   ^.1
  9877   "^DD",200, 200,11.7,1 ,1,0)
  9878   200^ARA
  9879   "^DD",200, 200,11.7,1 ,1,1)
  9880   S ^VA(200, "ARA",X,DA )=""
  9881   "^DD",200, 200,11.7,1 ,1,2)
  9882   K ^VA(200, "ARA",X,DA )
  9883   "^DD",200, 200,11.7,1 ,1,3)
  9884   This is us ed by GUI  to start n ew process es.
  9885   "^DD",200, 200,11.7,1 ,1,"%D",0)
  9886   ^^2^2^2940 506^
  9887   "^DD",200, 200,11.7,1 ,1,"%D",1, 0)
  9888   This X-ref  is used t o do a loo kup and fi nd a user  for networ k
  9889   "^DD",200, 200,11.7,1 ,1,"%D",2, 0)
  9890   and new pr ocess jobs .
  9891   "^DD",200, 200,11.7,1 ,1,"DT")
  9892   2940506
  9893   "^DD",200, 200,11.7,3 )
  9894   Answer mus t be 20-50  character s in lengt h.
  9895   "^DD",200, 200,11.7,2 1,0)
  9896   ^^1^1^2940 506^
  9897   "^DD",200, 200,11.7,2 1,1,0)
  9898   This value  is used t o identify  the user  in non int eractive c onnections .
  9899   "^DD",200, 200,11.7," DT")
  9900   2940506
  9901   "^DD",200, 200,12.1,0 )
  9902   CURRENT DE GREE LEVEL ^*P771.9'^ HL(771.9,^ 12;1^S DIC ("S")="I $ D(^(51,""B "",""OAA"" ))" D ^DIC  K DIC S D IC=$G(DIE) ,X=+Y K:Y< 0 X
  9903   "^DD",200, 200,12.1,3 )
  9904   Enter the  current de gree level  upon entr y into the  current t raining pr ogram/resi dency at t his VA med ical facil ity.
  9905   "^DD",200, 200,12.1,1 2)
  9906   You will o nly be abl e to selec t degrees  used by th e Office o f Academic  Affiliati ons.
  9907   "^DD",200, 200,12.1,1 2.1)
  9908   S DIC("S") ="I $D(^(5 1,""B"","" OAA""))"
  9909   "^DD",200, 200,12.1,2 1,0)
  9910   ^.001^2^2^ 3030512^^^ ^
  9911   "^DD",200, 200,12.1,2 1,1,0)
  9912   This is th e current  degree lev el upon en try into t he current  training
  9913   "^DD",200, 200,12.1,2 1,2,0)
  9914   program/re sidency at  this VA m edical fac ility.
  9915   "^DD",200, 200,12.1," DT")
  9916   3030516
  9917   "^DD",200, 200,12.2,0 )
  9918   PROGRAM OF  STUDY^P89 32.2'^USC( 8932.2,^12 ;2^Q
  9919   "^DD",200, 200,12.2,3 )
  9920   Enter a di scipline t hat best d escribes t he current  program o f study.
  9921   "^DD",200, 200,12.2,2 1,0)
  9922   ^^2^2^3030 512^^
  9923   "^DD",200, 200,12.2,2 1,1,0)
  9924   This is th e discipli ne that be st describ es the tra inee's cur rent
  9925   "^DD",200, 200,12.2,2 1,2,0)
  9926   program of  study at  this VA me dical faci lity.
  9927   "^DD",200, 200,12.2," DT")
  9928   3030516
  9929   "^DD",200, 200,12.3,0 )
  9930   LAST TRAIN ING MONTH  & YEAR^FXO ^^12;3^S % DT="EM" D  ^%DT S X=Y  K:Y<1 X K :((($E(Y)* 100)+1700) +$E(Y,2,3) )<2000 X I  $D(X) S X =$S($E(Y,4 ,4)=0:$E(Y ,5,5),1:$E (Y,4,5))_" /"_((($E(Y )*100)+170 0)+$E(Y,2, 3)) K:+$E( X)=0 X
  9931   "^DD",200, 200,12.3,2 )
  9932   S Y(0)=Y I  Y'="" N D IERR D DT^ DILF("",Y, .Y,"","DIE RR") S Y=$ $FMTE^XLFD T(Y,"D")
  9933   "^DD",200, 200,12.3,2 .1)
  9934   I Y'="" N  DIERR D DT ^DILF("",Y ,.Y,"","DI ERR") S Y= $$FMTE^XLF DT(Y,"D")
  9935   "^DD",200, 200,12.3,3 )
  9936   Answer wit h MONTH &  YEAR.  YEA R can NOT  be less th an 2000.
  9937   "^DD",200, 200,12.3,4 )
  9938   N %DT S %D T="M" D HE LP^%DTC
  9939   "^DD",200, 200,12.3,2 1,0)
  9940   ^.001^2^2^ 3040818^^^ ^
  9941   "^DD",200, 200,12.3,2 1,1,0)
  9942   This is th e MONTH an d LAST yea r the trai nee antici pates bein g in a
  9943   "^DD",200, 200,12.3,2 1,2,0)
  9944   training p rogram at  this VA me dical faci lity.
  9945   "^DD",200, 200,12.3," DT")
  9946   3070615
  9947   "^DD",200, 200,12.4,0 )
  9948   VHA TRAINI NG FACILIT Y^*P4'^DIC (4,^12;4^S  DIC("S")= "I $$SCRN4 ^XUOAAUTL( Y)" D ^DIC  K DIC S D IC=DIE,X=+ Y K:Y<0 X
  9949   "^DD",200, 200,12.4,3 )
  9950  
  9951   "^DD",200, 200,12.4,4 )
  9952   D HLP1^XUO AAUTL
  9953   "^DD",200, 200,12.4,1 2)
  9954   VAMCs, M&R OCs, RO-OC s and OCs  only
  9955   "^DD",200, 200,12.4,1 2.1)
  9956   S DIC("S") ="I $$SCRN 4^XUOAAUTL (Y)"
  9957   "^DD",200, 200,12.4," DT")
  9958   3050608
  9959   "^DD",200, 200,12.5,0 )
  9960   DATE HL7 T RAINEE REC ORD BUILT^ D^^12;5^S  %DT="EX" D  ^%DT S X= Y K:Y<1 X
  9961   "^DD",200, 200,12.5,1 ,0)
  9962   ^.1
  9963   "^DD",200, 200,12.5,1 ,1,0)
  9964   200^AOAA
  9965   "^DD",200, 200,12.5,1 ,1,1)
  9966   S ^VA(200, "AOAA",$E( X,1,30),DA )=""
  9967   "^DD",200, 200,12.5,1 ,1,2)
  9968   K ^VA(200, "AOAA",$E( X,1,30),DA )
  9969   "^DD",200, 200,12.5,1 ,1,"%D",0)
  9970   ^^2^2^3040 513^
  9971   "^DD",200, 200,12.5,1 ,1,"%D",1, 0)
  9972   This index  is index  reflects w hen the tr ansmission  of the tr ainee reco rd 
  9973   "^DD",200, 200,12.5,1 ,1,"%D",2, 0)
  9974   last took  place.
  9975   "^DD",200, 200,12.5,1 ,1,"DT")
  9976   3040513
  9977   "^DD",200, 200,12.5,2 1,0)
  9978   ^^2^2^3040 513^
  9979   "^DD",200, 200,12.5,2 1,1,0)
  9980   This is th e date tha t the trai nee inform ation was  built and  sent to th e
  9981   "^DD",200, 200,12.5,2 1,2,0)
  9982   OAA server .
  9983   "^DD",200, 200,12.5," DT")
  9984   3050110
  9985   "^DD",200, 200,12.6,0 )
  9986   CLINICAL C ORE TRAINE E^S^Y:YES; N:NO;^12;6 ^Q
  9987   "^DD",200, 200,12.6,3 )
  9988   Is this pe rson an ac tive Train ee?
  9989   "^DD",200, 200,12.6,2 1,0)
  9990   ^^1^1^3050 923^
  9991   "^DD",200, 200,12.6,2 1,1,0)
  9992   This field  designate s whether  or not the  person is  an active  Trainee.
  9993   "^DD",200, 200,12.6," DT")
  9994   3050105
  9995   "^DD",200, 200,12.7,0 )
  9996   DATE NO LO NGER TRAIN EE^DX^^12; 7^S %DT="E X",%DT(0)= "-"_DT D ^ %DT K %DT( 0) S X=Y K :Y<1 X
  9997   "^DD",200, 200,12.7,3 )
  9998   Answer wit h the Date  when this  Trainee b ecame inac tive. Futu re dates a re not all owed.
  9999   "^DD",200, 200,12.7,2 1,0)
  10000   ^^3^3^3050 923^
  10001   "^DD",200, 200,12.7,2 1,1,0)
  10002   This is th e date whe n a Regist ered Train ee is no l onger to b e consider ed
  10003   "^DD",200, 200,12.7,2 1,2,0)
  10004   an trainee .  This ma y be at th e end of a  rotation  period or  at the end  VA
  10005   "^DD",200, 200,12.7,2 1,3,0)
  10006   training e xperience.
  10007   "^DD",200, 200,12.7," DT")
  10008   3050923
  10009   "^DD",200, 200,12.8,0 )
  10010   START OF T RAINING^D^ ^12;8^S %D T="EX" D ^ %DT S X=Y  K:Y<1 X
  10011   "^DD",200, 200,12.8," DT")
  10012   3050105
  10013   "^DD",200, 200,13,0)
  10014   NICK NAME^ F^^.1;4^K: X[""""!($A (X)=45) X  I $D(X) K: X[""""!(X' ?.ANP)!(X< 0) X I $D( X) K:$L(X) >10!($L(X) <1) X
  10015   "^DD",200, 200,13,1,0 )
  10016   ^.1^^-1
  10017   "^DD",200, 200,13,1,1 ,0)
  10018   200^D^MUMP S
  10019   "^DD",200, 200,13,1,1 ,1)
  10020   S ^VA(200, "D",$$UP^X LFSTR($E(X ,1,30)),DA )=""
  10021   "^DD",200, 200,13,1,1 ,2)
  10022   K ^VA(200, "D",$$UP^X LFSTR($E(X ,1,30)),DA )
  10023   "^DD",200, 200,13,1,1 ,3)
  10024   This is a  UPPERCASE  regular X- ref
  10025   "^DD",200, 200,13,1,1 ,"%D",0)
  10026   ^^1^1^2941 121^
  10027   "^DD",200, 200,13,1,1 ,"%D",1,0)
  10028   The X-ref  is held in  UPPERCASE , it is a  regular X- ref otherw ise.
  10029   "^DD",200, 200,13,1,1 ,"DT")
  10030   2941121
  10031   "^DD",200, 200,13,3)
  10032   ANSWER MUS T BE 1-10  CHARACTERS  IN LENGTH
  10033   "^DD",200, 200,13,4)
  10034  
  10035   "^DD",200, 200,13,21, 0)
  10036   ^^2^2^2920 513^^^^
  10037   "^DD",200, 200,13,21, 1,0)
  10038   This is a  string tha t is used  in the sig n-on greet ing and
  10039   "^DD",200, 200,13,21, 2,0)
  10040   for mailma n user loo kup.
  10041   "^DD",200, 200,13,"DT ")
  10042   2941121
  10043   "^DD",200, 200,14,0)
  10044   PAC^FX^^.1 ;5^D LC^XU S K:$L(X)> 8!($L(X)<3 ) X
  10045   "^DD",200, 200,14,3)
  10046   ANSWER MUS T BE 3-8 C HARACTERS  IN LENGTH
  10047   "^DD",200, 200,14,10)
  10048   M
  10049   "^DD",200, 200,14,21, 0)
  10050   ^^2^2^2920 513^^^
  10051   "^DD",200, 200,14,21, 1,0)
  10052   This is a  code to be  checked b efore a us er is allo wed to get  into
  10053   "^DD",200, 200,14,21, 2,0)
  10054   programmer  mode.
  10055   "^DD",200, 200,14.9,0 )
  10056   HINQ EMPLO YEE NUMBER ^FX^^.1;9^ K:X[""""!( $A(X)=45)  X I $D(X)  K:$L(X)>4! ($L(X)<4)! '(X?4N) X  I $D(X),$D (^VA(200," AC",X)),'$ D(^(X,DA))  S DGEMP=X  K X
  10057   "^DD",200, 200,14.9,1 ,0)
  10058   ^.1^^-1
  10059   "^DD",200, 200,14.9,1 ,1,0)
  10060   200^AC
  10061   "^DD",200, 200,14.9,1 ,1,1)
  10062   S ^VA(200, "AC",$E(X, 1,30),DA)= ""
  10063   "^DD",200, 200,14.9,1 ,1,2)
  10064   K ^VA(200, "AC",$E(X, 1,30),DA)
  10065   "^DD",200, 200,14.9,3 )
  10066   Answer Mus t be 4 dig its and Un ique in Us er file.
  10067   "^DD",200, 200,14.9,4 )
  10068   I $D(DGEMP ),$D(^VA(2 00,"AC",DG EMP)),'$D( ^(DGEMP,DA )) S %=$O( ^VA(200,"A C",DGEMP,0 )) W ?5,"E mployee nu mber '",DG EMP,"' Alr eady assig ned to use r, ",$S($D (^VA(200,% ,0)):$P(^( 0),"^"),1: %) K DGEMP
  10069   "^DD",200, 200,14.9,2 1,0)
  10070   ^^2^2^2920 513^^
  10071   "^DD",200, 200,14.9,2 1,1,0)
  10072   The employ ee number  associated  with HINQ  passwords  from the  DVB should
  10073   "^DD",200, 200,14.9,2 1,2,0)
  10074   be entered  here.
  10075   "^DD",200, 200,14.9," DT")
  10076   2920630
  10077   "^DD",200, 200,15,0)
  10078   PROHIBITED  TIMES FOR  SIGN-ON^F ^^0;12^K:$ L(X)>9!($L (X)<9)!'(X ?4N1"-"4N)  X
  10079   "^DD",200, 200,15,3)
  10080   Time range  that this  user may  not sign-o n.
  10081   "^DD",200, 200,15,21, 0)
  10082   ^^4^4^2920 513^^^^
  10083   "^DD",200, 200,15,21, 1,0)
  10084   This is a  pair of ti mes within  which the  user will  not be al lowed
  10085   "^DD",200, 200,15,21, 2,0)
  10086   access to  the comput er.
  10087   "^DD",200, 200,15,21, 3,0)
  10088   They shoul d be enter ed in Mili tary forma t, for exa mple 0900- 1300 would
  10089   "^DD",200, 200,15,21, 4,0)
  10090   prohibit s ignons fro m 9AM to 1 PM each da y.
  10091   "^DD",200, 200,16,0)
  10092   DIVISION^2 00.02P^^2; 0
  10093   "^DD",200, 200,16,21, 0)
  10094   ^^2^2^2920 513^^^^
  10095   "^DD",200, 200,16,21, 1,0)
  10096   This is th e one or m ore divisi ons that t his user m ay sign-on  and do
  10097   "^DD",200, 200,16,21, 2,0)
  10098   work for.
  10099   "^DD",200, 200,19,0)
  10100   DELEGATE O F^P200'^VA (200,^19;1 ^Q
  10101   "^DD",200, 200,19,1,0 )
  10102   ^.1
  10103   "^DD",200, 200,19,1,1 ,0)
  10104   ^^TRIGGER^ 200^19.1
  10105   "^DD",200, 200,19,1,1 ,1)
  10106   K DIV S DI V=X,D0=DA, DIV(0)=D0  S Y(1)=$S( $D(^VA(200 ,D0,19)):^ (19),1:"")  S X=$P(Y( 1),U,2),X= X S DIU=X  K Y S X=DI V N %I,%H, % D NOW^%D TC X ^DD(2 00,19,1,1, 1.4)
  10107   "^DD",200, 200,19,1,1 ,1.4)
  10108   S DIH=$S($ D(^VA(200, DIV(0),19) ):^(19),1: ""),DIV=X  S $P(^(19) ,U,2)=DIV, DIH=200,DI G=19.1 D ^ DICR:$O(^D D(DIH,DIG, 1,0))>0
  10109   "^DD",200, 200,19,1,1 ,2)
  10110   Q
  10111   "^DD",200, 200,19,1,1 ,"%D",0)
  10112   ^^1^1^2920 513^
  10113   "^DD",200, 200,19,1,1 ,"%D",1,0)
  10114   Trigger th e DELEGATI ON DATE fi eld.
  10115   "^DD",200, 200,19,1,1 ,"CREATE V ALUE")
  10116   TODAY
  10117   "^DD",200, 200,19,1,1 ,"DELETE V ALUE")
  10118   NO EFFECT
  10119   "^DD",200, 200,19,1,1 ,"FIELD")
  10120   DELEGATION  DATE
  10121   "^DD",200, 200,19,21, 0)
  10122   ^^3^3^2920 513^^^^
  10123   "^DD",200, 200,19,21, 1,0)
  10124   This field  holds the  name of t he person  who has de legated me nu manager
  10125   "^DD",200, 200,19,21, 2,0)
  10126   authority  to the use r.  The us er is thus  the 'dele gate of' t he person
  10127   "^DD",200, 200,19,21, 3,0)
  10128   named here .
  10129   "^DD",200, 200,19,"DT ")
  10130   2890416
  10131   "^DD",200, 200,19.1,0 )
  10132   DELEGATION  DATE^D^^1 9;2^S %DT= "E" D ^%DT  S X=Y K:Y <1 X
  10133   "^DD",200, 200,19.1,5 ,1,0)
  10134   200^19^1
  10135   "^DD",200, 200,19.1,2 1,0)
  10136   ^^1^1^2920 513^^
  10137   "^DD",200, 200,19.1,2 1,1,0)
  10138   This field  records t he data th at the use r became a  delegate.
  10139   "^DD",200, 200,19.1," DT")
  10140   2880120
  10141   "^DD",200, 200,19.2,0 )
  10142   DELEGATION  LEVEL^NJ3 ,0^^19;3^K :+X'=X!(X> 999)!(X<0) !(X?.E1"." 1N.N) X
  10143   "^DD",200, 200,19.2,3 )
  10144   Type a Num ber betwee n 0 and 99 9, 0 Decim al Digits
  10145   "^DD",200, 200,19.2,2 1,0)
  10146   ^^5^5^2920 513^^^
  10147   "^DD",200, 200,19.2,2 1,1,0)
  10148   This field  records t he level o f delegati on authori ty with re spect to
  10149   "^DD",200, 200,19.2,2 1,2,0)
  10150   the system s manager,  level zer o.  When t he systems  manager d elegates
  10151   "^DD",200, 200,19.2,2 1,3,0)
  10152   authority  to someone  else, tha t person w ill be at  level one.   Levels
  10153   "^DD",200, 200,19.2,2 1,4,0)
  10154   are mainta ined so th at lower l evel deleg ates canno t interfer e with
  10155   "^DD",200, 200,19.2,2 1,5,0)
  10156   the menus  of higher  level dele gates.
  10157   "^DD",200, 200,19.2," DT")
  10158   2880120
  10159   "^DD",200, 200,19.4,0 )
  10160   ALERT DATE /TIME^200. 194DA^^XQA ;0
  10161   "^DD",200, 200,19.4,2 1,0)
  10162   ^^2^2^2930 402^
  10163   "^DD",200, 200,19.4,2 1,1,0)
  10164   This is a  multiple f ield which  is used t o generate  alerts to  the users .
  10165   "^DD",200, 200,19.4,2 1,2,0)
  10166   The data f or alerts  is filed b y date and  time.
  10167   "^DD",200, 200,19.5,0 )
  10168   DELEGATED  OPTIONS^20 0.19P^^19. 5;0
  10169   "^DD",200, 200,19.5,2 1,0)
  10170   ^^2^2^2920 513^^^^
  10171   "^DD",200, 200,19.5,2 1,1,0)
  10172   This is a  sub-file o f pointers  to the Op tion File  which deta il those
  10173   "^DD",200, 200,19.5,2 1,2,0)
  10174   options th is user ma y delegate  to others .
  10175   "^DD",200, 200,19.6,0 )
  10176   ALLOWABLE  NEW MENU P REFIX^200. 196A^^19.6 ;0
  10177   "^DD",200, 200,19.6,2 1,0)
  10178   ^.001^3^3^ 3080204^^^ ^
  10179   "^DD",200, 200,19.6,2 1,1,0)
  10180   This subfi le holds t he set of  namespaces  available  to this u ser in
  10181   "^DD",200, 200,19.6,2 1,2,0)
  10182   the creati on of menu s with del egated opt ions.
  10183   "^DD",200, 200,19.6,2 1,3,0)
  10184  
  10185   "^DD",200, 200,19.8,0 )
  10186   MENU TEMPL ATE^200.19 8A^^19.8;0
  10187   "^DD",200, 200,19.8,2 1,0)
  10188   ^^3^3^2930 407^^^
  10189   "^DD",200, 200,19.8,2 1,1,0)
  10190   This multi ple holds  sets of pr edefined m enus which  can be en voked by
  10191   "^DD",200, 200,19.8,2 1,2,0)
  10192   the user b y entering  a right-s quare-brac ket ("[")  followed b y a
  10193   "^DD",200, 200,19.8,2 1,3,0)
  10194   template's  name.
  10195   "^DD",200, 200,20,0)
  10196   UCI^200.01 ^^.2;0
  10197   "^DD",200, 200,20,21, 0)
  10198   ^^2^2^2920 513^^
  10199   "^DD",200, 200,20,21, 1,0)
  10200   This is th e set of U CI's that  this user  must choos e from at  sign-on
  10201   "^DD",200, 200,20,21, 2,0)
  10202   time.
  10203   "^DD",200, 200,20.1,0 )
  10204   DATE E-SIG  LAST CHAN GED^FO^^20 ;1^K:$L(X) >6!($L(X)< 5)!'(X?5.6 N) X
  10205   "^DD",200, 200,20.1,2 )
  10206   S Y(0)=Y S  %H=+Y D Y MD^%DTC S  Y=X X ^DD( "DD")
  10207   "^DD",200, 200,20.1,2 .1)
  10208   S %H=+Y D  YMD^%DTC S  Y=X X ^DD ("DD")
  10209   "^DD",200, 200,20.1,3 )
  10210   Answer mus t be 5-6 c haracters  in length.
  10211   "^DD",200, 200,20.1,5 ,1,0)
  10212   200^20.4^2
  10213   "^DD",200, 200,20.1,2 1,0)
  10214   ^^2^2^2951 002^^
  10215   "^DD",200, 200,20.1,2 1,1,0)
  10216   A $H date  of the las t time the  E-Sig cod e was chan ged. Trigg ered by a
  10217   "^DD",200, 200,20.1,2 1,2,0)
  10218   X-ref on t he ELECTRO NIC SIGNAT URE CODE f ield.
  10219   "^DD",200, 200,20.1," DT")
  10220   2951002
  10221   "^DD",200, 200,20.2,0 )
  10222   SIGNATURE  BLOCK PRIN TED NAME^F X^^20;2^K: X[""""!($A (X)=45)!($ L(X)>40)!( $L(X)<2) X  I $D(X) K :$$FORMAT^ XLFNAME7(X ,2,40,,0,, 1)'[$P(^VA (200,DA,0) ,",") X
  10223   "^DD",200, 200,20.2,1 ,0)
  10224   ^.1^^0
  10225   "^DD",200, 200,20.2,3 )
  10226   Enter your  name as y ou want it  to appear  on offici al documen ts
  10227   "^DD",200, 200,20.2,9 )
  10228   ^
  10229   "^DD",200, 200,20.2,2 1,0)
  10230   ^^6^6^3010 808^
  10231   "^DD",200, 200,20.2,2 1,1,0)
  10232   The name e ntered mus t contain  the surnam e of the u ser.
  10233   "^DD",200, 200,20.2,2 1,2,0)
  10234   The name m ust be 2 t o 40 chara cters in l ength.
  10235   "^DD",200, 200,20.2,2 1,3,0)
  10236    
  10237   "^DD",200, 200,20.2,2 1,4,0)
  10238   This field  can then  contain th e name of  the user a s they wis h it to
  10239   "^DD",200, 200,20.2,2 1,5,0)
  10240   be display ed with th e notation  that they  signed th e document  electroni cally.
  10241   "^DD",200, 200,20.2,2 1,6,0)
  10242   For exampl e:  John R . Doe, M.D .   or     Fred A. Sa mple, RN.
  10243   "^DD",200, 200,20.2," DT")
  10244   3050413
  10245   "^DD",200, 200,20.3,0 )
  10246   SIGNATURE  BLOCK TITL E^F^^20;3^ K:X[""""!( $A(X)=45)  X I $D(X)  K:$L(X)>50 !($L(X)<2)  X
  10247   "^DD",200, 200,20.3,1 ,0)
  10248   ^.1^^0
  10249   "^DD",200, 200,20.3,3 )
  10250   Enter your  title, e. g., Chief  of Surgery .
  10251   "^DD",200, 200,20.3,2 1,0)
  10252   ^^7^7^3010 808^
  10253   "^DD",200, 200,20.3,2 1,1,0)
  10254   This field  should co ntain the  title of t he person  who is ele ctronicall y
  10255   "^DD",200, 200,20.3,2 1,2,0)
  10256   signing a  document.   Examples  of titles  are Chief  of Surgery , Dieticia n,
  10257   "^DD",200, 200,20.3,2 1,3,0)
  10258   Clinical P harmacist,  etc.  Thi s title wi ll print n ext to the  name of t he
  10259   "^DD",200, 200,20.3,2 1,4,0)
  10260   person who  signs the  document.   The pers on's name  will be ta ken from t he
  10261   "^DD",200, 200,20.3,2 1,5,0)
  10262   SIGNATURE  BLOCK PRIN TED NAME f ield.
  10263   "^DD",200, 200,20.3,2 1,6,0)
  10264    
  10265   "^DD",200, 200,20.3,2 1,7,0)
  10266   The title  must be 2  to 50 char acters in  length.
  10267   "^DD",200, 200,20.3," DT")
  10268   3010808
  10269   "^DD",200, 200,20.4,0 )
  10270   ELECTRONIC  SIGNATURE  CODE^FOX^ ^20;4^K:$L (X)>20!($L (X)<6) X I  $D(X) D H ASH^XUSHSH P
  10271   "^DD",200, 200,20.4,1 ,0)
  10272   ^.1^^-1
  10273   "^DD",200, 200,20.4,1 ,2,0)
  10274   ^^TRIGGER^ 200^20.1
  10275   "^DD",200, 200,20.4,1 ,2,1)
  10276   K DIV S DI V=X,D0=DA, DIV(0)=D0  S Y(1)=$S( $D(^VA(200 ,D0,20)):^ (20),1:"")  S X=$P(Y( 1),U,1),X= X S DIU=X  K Y S X=DI V S X=+$H  X ^DD(200, 20.4,1,2,1 .4)
  10277   "^DD",200, 200,20.4,1 ,2,1.4)
  10278   S DIH=$S($ D(^VA(200, DIV(0),20) ):^(20),1: ""),DIV=X  S $P(^(20) ,U,1)=DIV, DIH=200,DI G=20.1 D ^ DICR:$O(^D D(DIH,DIG, 1,0))>0
  10279   "^DD",200, 200,20.4,1 ,2,2)
  10280   K DIV S DI V=X,D0=DA, DIV(0)=D0  S Y(1)=$S( $D(^VA(200 ,D0,20)):^ (20),1:"")  S X=$P(Y( 1),U,1),X= X S DIU=X  K Y S X=""  X ^DD(200 ,20.4,1,2, 2.4)
  10281   "^DD",200, 200,20.4,1 ,2,2.4)
  10282   S DIH=$S($ D(^VA(200, DIV(0),20) ):^(20),1: ""),DIV=X  S $P(^(20) ,U,1)=DIV, DIH=200,DI G=20.1 D ^ DICR:$O(^D D(DIH,DIG, 1,0))>0
  10283   "^DD",200, 200,20.4,1 ,2,3)
  10284   Required t o meet nee ds.
  10285   "^DD",200, 200,20.4,1 ,2,"%D",0)
  10286   ^^2^2^2960 705^
  10287   "^DD",200, 200,20.4,1 ,2,"%D",1, 0)
  10288   This X-ref  sets the  DATE E-SIG  LAST CHAN GED so we  can expire  the E-sig
  10289   "^DD",200, 200,20.4,1 ,2,"%D",2, 0)
  10290   after the  VERIFY cod e lifetime  days as t he G.C. as ked us to  do.
  10291   "^DD",200, 200,20.4,1 ,2,"CREATE  VALUE")
  10292   S X=+$H
  10293   "^DD",200, 200,20.4,1 ,2,"DELETE  VALUE")
  10294   @
  10295   "^DD",200, 200,20.4,1 ,2,"DT")
  10296   2960705
  10297   "^DD",200, 200,20.4,1 ,2,"FIELD" )
  10298   #20.1
  10299   "^DD",200, 200,20.4,2 )
  10300   S Y(0)=Y S  Y="<Hidde n>"
  10301   "^DD",200, 200,20.4,2 .1)
  10302   S Y="<Hidd en>"
  10303   "^DD",200, 200,20.4,3 )
  10304   Enter your  code (6-2 0 chars);  it won't d isplay!
  10305   "^DD",200, 200,20.4,2 1,0)
  10306   ^.001^4^4^ 3030703^^^
  10307   "^DD",200, 200,20.4,2 1,1,0)
  10308   This field  contains  the encryp ted code w hich the u ser types  when
  10309   "^DD",200, 200,20.4,2 1,2,0)
  10310   signing do cuments el ectronical ly.  The u ser's inpu t will be  compared t o
  10311   "^DD",200, 200,20.4,2 1,3,0)
  10312   this field  when vali dating his  electroni c signatur e.
  10313   "^DD",200, 200,20.4,2 1,4,0)
  10314   All electr onic signa ture codes  should be  treated a s confiden tial.
  10315   "^DD",200, 200,20.4," DT")
  10316   2960705
  10317   "^DD",200, 200,28,0)
  10318   MAIL CODE^ F^^5;2^K:X [""""!($A( X)=45) X I  $D(X) K:$ L(X)>10!($ L(X)<2) X
  10319   "^DD",200, 200,28,.1)
  10320   VA HOSPITA L SERVICE  NUMBER, I. E. 116A FO R PSYCHIAT RY, 116B F OR PSYCHOL OGY, ETC
  10321   "^DD",200, 200,28,1,0 )
  10322   ^.1^^0
  10323   "^DD",200, 200,28,1,2 ,0)
  10324   200^E
  10325   "^DD",200, 200,28,1,2 ,1)
  10326   S ^VA(200, "E",$E(X,1 ,30),DA)=" "
  10327   "^DD",200, 200,28,1,2 ,2)
  10328   K ^VA(200, "E",$E(X,1 ,30),DA)
  10329   "^DD",200, 200,28,1,2 ,"DT")
  10330   2930309
  10331   "^DD",200, 200,28,3)
  10332   ANSWER MUS T BE 2-10  CHARACTERS  IN LENGTH
  10333   "^DD",200, 200,28,10)
  10334   SYSTEM MAN AGER
  10335   "^DD",200, 200,28,21, 0)
  10336   ^^1^1^2920 317^
  10337   "^DD",200, 200,28,21, 1,0)
  10338   This is th e mail cod e for the  new person .
  10339   "^DD",200, 200,28,"DT ")
  10340   2890418
  10341   "^DD",200, 200,29,0)
  10342   SERVICE/SE CTION^RP49 '^DIC(49,^ 5;1^Q
  10343   "^DD",200, 200,29,1,0 )
  10344   ^.1
  10345   "^DD",200, 200,29,1,1 ,0)
  10346   200^E
  10347   "^DD",200, 200,29,1,1 ,1)
  10348   S ^VA(200, "E",$E(X,1 ,30),DA)=" "
  10349   "^DD",200, 200,29,1,1 ,2)
  10350   K ^VA(200, "E",$E(X,1 ,30),DA)
  10351   "^DD",200, 200,29,1,1 ,"DT")
  10352   3000218
  10353   "^DD",200, 200,29,21, 0)
  10354   ^^1^1^2920 317^
  10355   "^DD",200, 200,29,21, 1,0)
  10356   This is th e name of  the servic e or secti on for the  new perso n.
  10357   "^DD",200, 200,29,"DT ")
  10358   3000218
  10359   "^DD",200, 200,30,0)
  10360   DATE ENTER ED^D^^1;7^ S %DT="E"  D ^%DT S X =Y K:Y<1 X
  10361   "^DD",200, 200,30,9)
  10362   ^
  10363   "^DD",200, 200,30,21, 0)
  10364   ^^2^2^2851 003^
  10365   "^DD",200, 200,30,21, 1,0)
  10366   This is th e date on  which the  user was e ntered int o the user  file.
  10367   "^DD",200, 200,30,21, 2,0)
  10368   It is auto matically  inserted i nto the fi le by the  ADD USER o ption.
  10369   "^DD",200, 200,31,0)
  10370   CREATOR^P2 00^VA(200, ^1;8^Q
  10371   "^DD",200, 200,31,9)
  10372   ^
  10373   "^DD",200, 200,31,21, 0)
  10374   ^^2^2^2851 003^
  10375   "^DD",200, 200,31,21, 1,0)
  10376   This is th e name of  the user w ho entered  this user  into the  user file.
  10377   "^DD",200, 200,31,21, 2,0)
  10378   It is auto matically  set by the  ADD USER  option.
  10379   "^DD",200, 200,31,"DT ")
  10380   2870731
  10381   "^DD",200, 200,31.1,0 )
  10382   FILE RANGE ^FX^^1;1^K :$L(X)>30! ($L(X)<1)! (X<2)!'(X? 1.N.1".".2 N1"-"1.N.1 ".".2N) X  I $D(X),$P (X,"-",2)' >$P(X,"-")  K X
  10383   "^DD",200, 200,31.1,3 )
  10384   Enter a ra nge of num bers, e.g. , 10000-10 000.99.  T he second  number mus t be large r than the  first.
  10385   "^DD",200, 200,31.1,2 1,0)
  10386   2^^3^3^288 0706^^
  10387   "^DD",200, 200,31.1,2 1,1,0)
  10388   This field  limits a  user to a  specific r ange of fi le numbers .  When
  10389   "^DD",200, 200,31.1,2 1,2,0)
  10390   creating n ew files,  only a num ber within  this rang e can be a ssigned
  10391   "^DD",200, 200,31.1,2 1,3,0)
  10392   to the new  file.
  10393   "^DD",200, 200,31.1," DT")
  10394   2880712
  10395   "^DD",200, 200,31.2,0 )
  10396   TEXT TERMI NATOR^F^^1 ;4^K:$L(X) >5!($L(X)< 1) X
  10397   "^DD",200, 200,31.2,3 )
  10398   ANSWER MUS T BE 1-5 C HARACTERS  IN LENGTH
  10399   "^DD",200, 200,31.2,2 1,0)
  10400   ^^8^8^2890 124^
  10401   "^DD",200, 200,31.2,2 1,1,0)
  10402   If specifi ed, the ch aracter st ring in th is field w ill be use d instead
  10403   "^DD",200, 200,31.2,2 1,2,0)
  10404   of a carri age return  to mark t he end of  word-proce ssing text .  It will
  10405   "^DD",200, 200,31.2,2 1,3,0)
  10406   be used in  all VA Fi leMan word -processin g contexts , e.g. in  mail
  10407   "^DD",200, 200,31.2,2 1,4,0)
  10408   messages.   It can fa cilitate t he uploadi ng of file s from a P C
  10409   "^DD",200, 200,31.2,2 1,5,0)
  10410   environmen t.
  10411   "^DD",200, 200,31.2,2 1,6,0)
  10412    
  10413   "^DD",200, 200,31.2,2 1,7,0)
  10414   Note that  the VA Fil eMan edit  menu provi des an opt ion for te mporarily
  10415   "^DD",200, 200,31.2,2 1,8,0)
  10416   specifying  a text te rminator f or that ed it session  only.
  10417   "^DD",200, 200,31.2," DT")
  10418   2880630
  10419   "^DD",200, 200,31.3,0 )
  10420   PREFERRED  EDITOR^P1. 2'^DIST(1. 2,^1;5^Q
  10421   "^DD",200, 200,31.3,2 1,0)
  10422   ^^5^5^2920 702^
  10423   "^DD",200, 200,31.3,2 1,1,0)
  10424   If an entr y exists i n this fie ld, then w henever a  user edits  data in a
  10425   "^DD",200, 200,31.3,2 1,2,0)
  10426   FileMan wo rd-process ing field,  they will  automatic ally be tr ansferred  into
  10427   "^DD",200, 200,31.3,2 1,3,0)
  10428   their pref erred edit or.  If th is field i s blank, t hen the de fault edit or
  10429   "^DD",200, 200,31.3,2 1,4,0)
  10430   will be ei ther the F ileMan scr een editor  when edit ing within  ScreenMan
  10431   "^DD",200, 200,31.3,2 1,5,0)
  10432   format, or  the stand ard FileMa n line edi tor in all  other cas es.
  10433   "^DD",200, 200,31.3," DT")
  10434   2910307
  10435   "^DD",200, 200,32,0)
  10436   ACCESSIBLE  FILE^200. 032PA^^FOF ;0
  10437   "^DD",200, 200,32,9)
  10438   ^
  10439   "^DD",200, 200,32,21, 0)
  10440   ^^6^6^2940 627^^^
  10441   "^DD",200, 200,32,21, 1,0)
  10442   This multi ple-valued  field con tains the  list of fi les the us er may acc ess.
  10443   "^DD",200, 200,32,21, 2,0)
  10444   The type o f access g ranted to  the user i s included  for each  file that
  10445   "^DD",200, 200,32,21, 3,0)
  10446   appears on  the list.   The user  may be al lowed to l ook at rec ords (READ
  10447   "^DD",200, 200,32,21, 4,0)
  10448   access), e dit existi ng records  (WRITE ac cess), add  new recor d (LAYGO
  10449   "^DD",200, 200,32,21, 5,0)
  10450   access), d elete reco rds (DELET E access),  or modify  the file  structure
  10451   "^DD",200, 200,32,21, 6,0)
  10452   (DATA DICT IONARY ACC ESS).
  10453   "^DD",200, 200,41,0)
  10454   ALLOWED TO  USE SPOOL ER^S^y:YES ;n:NO;^SPL ;1^Q
  10455   "^DD",200, 200,41,3)
  10456   Is this us er allowed  to spool  documents?
  10457   "^DD",200, 200,41,21, 0)
  10458   ^^2^2^2890 124^
  10459   "^DD",200, 200,41,21, 1,0)
  10460   If set to  'YES', thi s user wil l be able  to use the  spool dev ice to
  10461   "^DD",200, 200,41,21, 2,0)
  10462   create spo ol documen ts.
  10463   "^DD",200, 200,41,"DT ")
  10464   2880203
  10465   "^DD",200, 200,41.1,0 )
  10466   MULTI-DEVI CE DESPOOL ING^S^y:YE S;n:NO;^SP L;2^Q
  10467   "^DD",200, 200,41.1,3 )
  10468   Can user d espool to  multiple d evices at  once.
  10469   "^DD",200, 200,41.1,2 1,0)
  10470   ^^2^2^2890 124^^
  10471   "^DD",200, 200,41.1,2 1,1,0)
  10472   If set to  'YES', the  user will  be able t o print (d espool) a  spooled
  10473   "^DD",200, 200,41.1,2 1,2,0)
  10474   document t o more tha n one devi ce simulta neously.
  10475   "^DD",200, 200,41.1," DT")
  10476   2880203
  10477   "^DD",200, 200,41.2,0 )
  10478   CAN MAKE I NTO A MAIL  MESSAGE^S ^y:YES;n:N O;^SPL;3^Q
  10479   "^DD",200, 200,41.2,2 1,0)
  10480   ^^5^5^2890 124^
  10481   "^DD",200, 200,41.2,2 1,1,0)
  10482   If set to  'YES', the  document  is given t he status  of a mail  message an d
  10483   "^DD",200, 200,41.2,2 1,2,0)
  10484   the user w ill be abl e to use a ll MailMan  functions  such as c opying and
  10485   "^DD",200, 200,41.2,2 1,3,0)
  10486   forwarding .  As a ma il message , the docu ment can n o longer b e manipula ted
  10487   "^DD",200, 200,41.2,2 1,4,0)
  10488   with the s pooler sin ce its fla g in the S pool Docum ent File h as been
  10489   "^DD",200, 200,41.2,2 1,5,0)
  10490   deleted.
  10491   "^DD",200, 200,41.2," DT")
  10492   2880215
  10493   "^DD",200, 200,41.97, 0)
  10494   AUTHORIZE  RELEASE OF  NPI^S^1:Y es;^NPI;3^ Q
  10495   "^DD",200, 200,41.97, 3)
  10496   Answer 1 ( Yes) to au thorize bl anket rele ase of NPI  to non-VA  entities  for busine ss purpose s only.
  10497   "^DD",200, 200,41.97, 21,0)
  10498   ^^7^7^3080 514^
  10499   "^DD",200, 200,41.97, 21,1,0)
  10500   Answer 1 ( Yes) if th is disclos ure of an  individual  practitio ner's NPI  is 
  10501   "^DD",200, 200,41.97, 21,2,0)
  10502   to a non-V A health c are provid er or its  agent to s upport, or  in 
  10503   "^DD",200, 200,41.97, 21,3,0)
  10504   anticipati on of supp orting, th e submissi on of heal th care re imbursemen
  10505   "^DD",200, 200,41.97, 21,4,0)
  10506   claims by  non-VA hea lth care p roviders o r their ag ents (ex.,  display o
  10507   "^DD",200, 200,41.97, 21,5,0)
  10508   FEE Basis  authorizat ions). Per  Routine U se Amendme nt #18 to  the Privac
  10509   "^DD",200, 200,41.97, 21,6,0)
  10510   Act of 197 4 this dis closure ca n be made  without re quiring co nsent 
  10511   "^DD",200, 200,41.97, 21,7,0)
  10512   (Blanket A uthority)  from the p ractitione r.
  10513   "^DD",200, 200,41.97, 23,0)
  10514   ^^6^6^3080 603^
  10515   "^DD",200, 200,41.97, 23,1,0)
  10516   Per Routin e Use Amen dment #18  to the Pri vacy Act o f 1974 thi s disclosu re 
  10517   "^DD",200, 200,41.97, 23,2,0)
  10518   can now be  made with out requir ing author ization fr om the pra ctitioner.  
  10519   "^DD",200, 200,41.97, 23,3,0)
  10520   This field  needs to  remain on  File 200 b ecause app lications  are using  it. 
  10521   "^DD",200, 200,41.97, 23,4,0)
  10522   For VA pra ctitioners  who have  an NPI in  The Revenu e Program  Billing an
  10523   "^DD",200, 200,41.97, 23,5,0)
  10524   Collection s Records  VA (114VA1 6), the fi eld will b e set 1 (Y es). For 
  10525   "^DD",200, 200,41.97, 23,6,0)
  10526   other user s, the fie ld will be  null.
  10527   "^DD",200, 200,41.97, "DT")
  10528   3080603
  10529   "^DD",200, 200,41.98, 0)
  10530   NPI ENTRY  STATUS^S^N :NEEDS ENT RY;E:EXEMP T;D:DONE;^ NPI;2^Q
  10531   "^DD",200, 200,41.98, 3)
  10532   This field  is filled  in automa tically if  needed.
  10533   "^DD",200, 200,41.98, 21,0)
  10534   ^^10^10^30 60508^
  10535   "^DD",200, 200,41.98, 21,1,0)
  10536   This field  is used i n tracking  the entry  status of  NPI d ata  for those
  10537   "^DD",200, 200,41.98, 21,2,0)
  10538   providers  who requir e an NPI.   The provi ders needi ng this va lue are
  10539   "^DD",200, 200,41.98, 21,3,0)
  10540   identified  based on  data enter ed in the  PERSON CLA SS subfile  which
  10541   "^DD",200, 200,41.98, 21,4,0)
  10542   indicates  providers  that may b e related  to billing  activitie s.
  10543   "^DD",200, 200,41.98, 21,5,0)
  10544    
  10545   "^DD",200, 200,41.98, 21,6,0)
  10546   The value  is initial ly set to  N or NEEDS  ENTRY.  I t can be c hanged to  E or
  10547   "^DD",200, 200,41.98, 21,7,0)
  10548   EXEMPT for  individua ls who hav e been ide ntified, b ut who due  to
  10549   "^DD",200, 200,41.98, 21,8,0)
  10550   administra tive activ ities, etc ., will no t be invol ved in act ivities
  10551   "^DD",200, 200,41.98, 21,9,0)
  10552   requiring  billing.   When the N PI value i s entered,  the value  is change d to
  10553   "^DD",200, 200,41.98, 21,10,0)
  10554   D or DONE.
  10555   "^DD",200, 200,41.98, "DT")
  10556   3060508
  10557   "^DD",200, 200,41.99, 0)
  10558   NPI^FX^^NP I;1^K:'($$ CHKDGT^XUS NPIE1(X,DA ,"Individu al_ID")) X
  10559   "^DD",200, 200,41.99, 1,0)
  10560   ^.1
  10561   "^DD",200, 200,41.99, 1,1,0)
  10562   200^ANPI
  10563   "^DD",200, 200,41.99, 1,1,1)
  10564   S ^VA(200, "ANPI",$E( X,1,30),DA )=""
  10565   "^DD",200, 200,41.99, 1,1,2)
  10566   K ^VA(200, "ANPI",$E( X,1,30),DA )
  10567   "^DD",200, 200,41.99, 1,1,"%D",0 )
  10568   ^^1^1^3060 301^
  10569   "^DD",200, 200,41.99, 1,1,"%D",1 ,0)
  10570   File entri es by NPI.
  10571   "^DD",200, 200,41.99, 1,1,"DT")
  10572   3060301
  10573   "^DD",200, 200,41.99, 1,2,0)
  10574   200^AMPI41 99^MUMPS
  10575   "^DD",200, 200,41.99, 1,2,1)
  10576   D XREF^XUM PI(DA)
  10577   "^DD",200, 200,41.99, 1,2,2)
  10578   D XREF^XUM PI(DA)
  10579   "^DD",200, 200,41.99, 1,2,"%D",0 )
  10580   ^^4^4^3100 903^
  10581   "^DD",200, 200,41.99, 1,2,"%D",1 ,0)
  10582   This cross  reference  sets the  Requires T ransmissio n (#902) f ield if th e
  10583   "^DD",200, 200,41.99, 1,2,"%D",2 ,0)
  10584   enumeratio n process  has begun  for this f ile.  Sett ing that f ield will
  10585   "^DD",200, 200,41.99, 1,2,"%D",3 ,0)
  10586   result in  a VPID bei ng assigne d or an up date messa ge being s ent to the  MPI
  10587   "^DD",200, 200,41.99, 1,2,"%D",4 ,0)
  10588   for this c hange in d ata.
  10589   "^DD",200, 200,41.99, 1,2,"DT")
  10590   3100805
  10591   "^DD",200, 200,41.99, 3)
  10592   Answer mus t be 10 di git value  assigned b y Centers  for Medica re and Med icaid Serv ices (CMS) .
  10593   "^DD",200, 200,41.99, 21,0)
  10594   ^^6^6^3070 918^
  10595   "^DD",200, 200,41.99, 21,1,0)
  10596   Each VHA B illable Pr actitioner  should ha ve applied  for the N PI through
  10597   "^DD",200, 200,41.99, 21,2,0)
  10598   CMS' Natio nal Plan a nd Provide r Enumerat ion System  (NPPES).   NPI
  10599   "^DD",200, 200,41.99, 21,3,0)
  10600   Confirmati on Letters  are sent  by CMS and  indicate  the NPI as signed.
  10601   "^DD",200, 200,41.99, 21,4,0)
  10602   Practition ers may pr esent thei r NPI Conf irmation L etter as a  source
  10603   "^DD",200, 200,41.99, 21,5,0)
  10604   document t o verify t he accurac y of the N PI or you  may contac t your Loc al
  10605   "^DD",200, 200,41.99, 21,6,0)
  10606   NPI Mainte nance Team  Leader fo r assistan ce.
  10607   "^DD",200, 200,41.99, "DT")
  10608   3100805
  10609   "^DD",200, 200,42,0)
  10610   EFFECTIVE  DATE/TIME^ 200.042D^^ NPISTATUS; 0
  10611   "^DD",200, 200,42,"DT ")
  10612   3060425
  10613   "^DD",200, 200,50.1,0 )
  10614   KEY DELEGA TION LEVEL ^NJ3,0^^50 ;1^K:+X'=X !(X>999)!( X<1)!(X?.E 1"."1N.N)  X
  10615   "^DD",200, 200,50.1,3 )
  10616   Type a Num ber betwee n 1 and 99 9, 0 Decim al Digits
  10617   "^DD",200, 200,50.1,2 1,0)
  10618   ^^2^2^2911 230^
  10619   "^DD",200, 200,50.1,2 1,1,0)
  10620   This a sim ple, numer ic value w hich preve nts removi ng delegat ed keys
  10621   "^DD",200, 200,50.1,2 1,2,0)
  10622   from someo ne with a  lower leve l number.
  10623   "^DD",200, 200,50.1," DT")
  10624   2890926
  10625   "^DD",200, 200,51,0)
  10626   KEYS^200.0 51PA^^51;0
  10627   "^DD",200, 200,51,12)
  10628   The person  granting  must hold  as a deleg ated key w hich s/he  may re-del egate.
  10629   "^DD",200, 200,51,12. 1)
  10630   S DIC("S") ="I DUZ(0) =""@""!$D( ^VA(200,DU Z,52,Y,0)) "
  10631   "^DD",200, 200,51,21, 0)
  10632   ^^2^2^2920 508^^^^
  10633   "^DD",200, 200,51,21, 1,0)
  10634   These are  "keys" tha t define t he charact eristic(s) , authoriz ation(s),  or
  10635   "^DD",200, 200,51,21, 2,0)
  10636   privilege( s) of the  person.
  10637   "^DD",200, 200,51,"DT ")
  10638   2890926
  10639   "^DD",200, 200,52,0)
  10640   DELEGATED  KEYS^200.0 52P^^52;0
  10641   "^DD",200, 200,52,12)
  10642   The person  granting  must hold  as a deleg ated key w hich s/he  may re-del egate.
  10643   "^DD",200, 200,52,12. 1)
  10644   S DIC("S") ="I DUZ(0) =""@""!$S( '$D(^VA(20 0,DUZ,52,Y ,0)):0,1:$ P(^(0),U,4 )"
  10645   "^DD",200, 200,52,21, 0)
  10646   ^^2^2^2920 423^
  10647   "^DD",200, 200,52,21, 1,0)
  10648   This subfi le contain s pointers  to the Ke y File of  those keys  that
  10649   "^DD",200, 200,52,21, 2,0)
  10650   this perso n is allow ed to allo cate to ot her users.
  10651   "^DD",200, 200,52,"DT ")
  10652   2920423
  10653   "^DD",200, 200,53.1,0 )
  10654   AUTHORIZED  TO WRITE  MED ORDERS ^S^1:YES;^ PS;1^Q
  10655   "^DD",200, 200,53.1,3 )
  10656   Enter '1'  or 'Yes' i f provider  is author ized to wr ite orders .
  10657   "^DD",200, 200,53.1,2 0,0)
  10658   ^.3LA^1^1
  10659   "^DD",200, 200,53.1,2 0,1,0)
  10660   PS
  10661   "^DD",200, 200,53.1,2 0,2,0)
  10662   PSO
  10663   "^DD",200, 200,53.1,2 1,0)
  10664   ^^1^1^2930 506^
  10665   "^DD",200, 200,53.1,2 1,1,0)
  10666   This field  is used t o determin  if the pr ovider is  authorized  to write  orders.
  10667   "^DD",200, 200,53.1,2 3,0)
  10668   ^^1^1^2920 930^^
  10669   "^DD",200, 200,53.1,2 3,1,0)
  10670   set of cod es
  10671   "^DD",200, 200,53.1," DT")
  10672   2960430
  10673   "^DD",200, 200,53.11, 0)
  10674   DETOX/MAIN TENANCE ID  NUMBER^F^ ^PS;11^K:$ L(X)>9!($L (X)<3)!'(X ?2A7N) X
  10675   "^DD",200, 200,53.11, 3)
  10676   Enter the  Detox/Main tenance ID  number fo r the prov ider.
  10677   "^DD",200, 200,53.11, 21,0)
  10678   ^.001^6^6^ 3120828^^^ ^
  10679   "^DD",200, 200,53.11, 21,1,0)
  10680   This field  holds the  Detoxific ation/Main tenance ID  number us ed for the  
  10681   "^DD",200, 200,53.11, 21,2,0)
  10682   substance  abuse prov iders that  is "DATA- waived". ( one X, one  alpha, 
  10683   "^DD",200, 200,53.11, 21,3,0)
  10684   7 numbers)
  10685   "^DD",200, 200,53.11, 21,4,0)
  10686  
  10687   "^DD",200, 200,53.11, 21,5,0)
  10688  
  10689   "^DD",200, 200,53.11, 21,6,0)
  10690  
  10691   "^DD",200, 200,53.11, "DT")
  10692   3111019
  10693   "^DD",200, 200,53.2,0 )
  10694   DEA#^FX^^P S;2^K:'$$V ALDEA^XUSE R2(X) X
  10695   "^DD",200, 200,53.2,1 ,0)
  10696   ^.1^^-1
  10697   "^DD",200, 200,53.2,1 ,1,0)
  10698   200^PS1
  10699   "^DD",200, 200,53.2,1 ,1,1)
  10700   S ^VA(200, "PS1",$E(X ,1,30),DA) =""
  10701   "^DD",200, 200,53.2,1 ,1,2)
  10702   K ^VA(200, "PS1",$E(X ,1,30),DA)
  10703   "^DD",200, 200,53.2,1 ,1,3)
  10704   Lookup pro viders by  their DEA  number
  10705   "^DD",200, 200,53.2,1 ,1,"%D",0)
  10706   ^^1^1^2931 208^^
  10707   "^DD",200, 200,53.2,1 ,1,"%D",1, 0)
  10708   This was ' APS1' befo re.  Also  used to st op duplica te numbers .
  10709   "^DD",200, 200,53.2,1 ,1,"DT")
  10710   2930924
  10711   "^DD",200, 200,53.2,1 ,2,0)
  10712   200^AMPI53 2^MUMPS
  10713   "^DD",200, 200,53.2,1 ,2,1)
  10714   D XREF^XUM PI(DA)
  10715   "^DD",200, 200,53.2,1 ,2,2)
  10716   D XREF^XUM PI(DA)
  10717   "^DD",200, 200,53.2,1 ,2,"%D",0)
  10718   ^^4^4^3100 903^
  10719   "^DD",200, 200,53.2,1 ,2,"%D",1, 0)
  10720   This cross  reference  sets the  Requires T ransmissio n (#902) f ield if th e
  10721   "^DD",200, 200,53.2,1 ,2,"%D",2, 0)
  10722   enumeratio n process  has begun  for this f ile.  Sett ing that f ield will
  10723   "^DD",200, 200,53.2,1 ,2,"%D",3, 0)
  10724   result in  a VPID bei ng assigne d or an up date messa ge being s ent to the  MPI
  10725   "^DD",200, 200,53.2,1 ,2,"%D",4, 0)
  10726   for this c hange in d ata.
  10727   "^DD",200, 200,53.2,1 ,2,"DT")
  10728   3100805
  10729   "^DD",200, 200,53.2,3 )
  10730   Enter the  DEA number  2 letters  7 numbers .
  10731   "^DD",200, 200,53.2,4 )
  10732   W:$X>5 ! W  ?5,"Enter  the DEA n umber as t wo upper c ase letter s followed  by 7 digi ts",!,?5," e.g. AA123 4567.  Eac h provider  must have  a unique  number.",!
  10733   "^DD",200, 200,53.2,2 0,0)
  10734   ^.3LA^1^1
  10735   "^DD",200, 200,53.2,2 0,1,0)
  10736   PS
  10737   "^DD",200, 200,53.2,2 0,2,0)
  10738   PSO
  10739   "^DD",200, 200,53.2,2 1,0)
  10740   ^.001^4^4^ 3120828^^^ ^
  10741   "^DD",200, 200,53.2,2 1,1,0)
  10742   This field  is used t o enter th e Drug Enf orcement A gency (DEA ) number.
  10743   "^DD",200, 200,53.2,2 1,2,0)
  10744   Enter the  DEA number  as two up per case l etters fol lowed by 7  digits.
  10745   "^DD",200, 200,53.2,2 1,3,0)
  10746   e.g., AA12 34567.  Ea ch provide r must hav e a unique  number.
  10747   "^DD",200, 200,53.2,2 1,4,0)
  10748  
  10749   "^DD",200, 200,53.2,2 3,0)
  10750   ^.001^22^2 2^3120828^ ^^^
  10751   "^DD",200, 200,53.2,2 3,1,0)
  10752   This is th e algorith m for the  DEA number  checking.
  10753   "^DD",200, 200,53.2,2 3,2,0)
  10754  
  10755   "^DD",200, 200,53.2,2 3,3,0)
  10756   The first  letter for  practitio ners (phys icians, de ntists, ve terinarian s,
  10757   "^DD",200, 200,53.2,2 3,4,0)
  10758   pharmacies  etc.) is  either an  "A" or "B"
  10759   "^DD",200, 200,53.2,2 3,5,0)
  10760    
  10761   "^DD",200, 200,53.2,2 3,6,0)
  10762   The second  letter sh ould be th e first le tter of th e practiti oner's las t
  10763   "^DD",200, 200,53.2,2 3,7,0)
  10764   name.  Som etimes thi s does not  match if  the regist rant chang ed their n ame 
  10765   "^DD",200, 200,53.2,2 3,8,0)
  10766   or the DEA  did not g et it corr ect the fi rst time.
  10767   "^DD",200, 200,53.2,2 3,9,0)
  10768    
  10769   "^DD",200, 200,53.2,2 3,10,0)
  10770   The check  digit algo rithm is a s follows:
  10771   "^DD",200, 200,53.2,2 3,11,0)
  10772    
  10773   "^DD",200, 200,53.2,2 3,12,0)
  10774   AS1234563
  10775   "^DD",200, 200,53.2,2 3,13,0)
  10776    
  10777   "^DD",200, 200,53.2,2 3,14,0)
  10778   1 + 3 + 5  =   9
  10779   "^DD",200, 200,53.2,2 3,15,0)
  10780   2 + 4 + 6  = 12 x 2 =  24
  10781   "^DD",200, 200,53.2,2 3,16,0)
  10782    
  10783   "^DD",200, 200,53.2,2 3,17,0)
  10784   9 + 24 = 3 3
  10785   "^DD",200, 200,53.2,2 3,18,0)
  10786    
  10787   "^DD",200, 200,53.2,2 3,19,0)
  10788   The last d igit of th e total mu st equal t he check d igit (the  last
  10789   "^DD",200, 200,53.2,2 3,20,0)
  10790   digit of t he DEA num ber).
  10791   "^DD",200, 200,53.2,2 3,21,0)
  10792   (33#10)=$E ("AS123456 3",9)
  10793   "^DD",200, 200,53.2,2 3,22,0)
  10794  
  10795   "^DD",200, 200,53.2," DT")
  10796   3021223
  10797   "^DD",200, 200,53.3,0 )
  10798   VA#^FX^^PS ;3^S X=$$U P^XLFSTR(X ) K:X["""" !($A(X)=45 ) X I $D(X ) K:$L(X)> 10!($L(X)< 3)!(X[" ")  X D VANUM ^XUSER2
  10799   "^DD",200, 200,53.3,1 ,0)
  10800   ^.1^^-1
  10801   "^DD",200, 200,53.3,1 ,1,0)
  10802   200^PS2
  10803   "^DD",200, 200,53.3,1 ,1,1)
  10804   S ^VA(200, "PS2",$E(X ,1,30),DA) =""
  10805   "^DD",200, 200,53.3,1 ,1,2)
  10806   K ^VA(200, "PS2",$E(X ,1,30),DA)
  10807   "^DD",200, 200,53.3,1 ,1,3)
  10808   Lookup pro viders by  their VA n umber
  10809   "^DD",200, 200,53.3,1 ,1,"%D",0)
  10810   ^^1^1^2931 208^^
  10811   "^DD",200, 200,53.3,1 ,1,"%D",1, 0)
  10812   This was ' APS2' befo re. Also u sed to sto p duplicat e numbers.
  10813   "^DD",200, 200,53.3,1 ,1,"DT")
  10814   2930924
  10815   "^DD",200, 200,53.3,3 )
  10816   Enter the  VA number  3 to 10 ch aracters w ith NO spa ces.
  10817   "^DD",200, 200,53.3,4 )
  10818   D EN^DDIOL ("Enter th e VA numbe r.  VA num ber must b e unique a mong activ e provider s.",,"!,?5 ")
  10819   "^DD",200, 200,53.3,2 0,0)
  10820   ^.3LA^1^1
  10821   "^DD",200, 200,53.3,2 0,1,0)
  10822   PS
  10823   "^DD",200, 200,53.3,2 0,2,0)
  10824   PSO
  10825   "^DD",200, 200,53.3,2 1,0)
  10826   ^^2^2^3021 210^
  10827   "^DD",200, 200,53.3,2 1,1,0)
  10828   This field  is used t o enter th e VA numbe r.
  10829   "^DD",200, 200,53.3,2 1,2,0)
  10830   The VA num ber must b e unique.
  10831   "^DD",200, 200,53.3," DT")
  10832   3121018
  10833   "^DD",200, 200,53.4,0 )
  10834   INACTIVE D ATE^D^^PS; 4^S %DT="E X" D ^%DT  S X=Y K:Y< 1 X
  10835   "^DD",200, 200,53.4,1 ,0)
  10836   ^.1^^0
  10837   "^DD",200, 200,53.4,3 )
  10838   Enter the  date after  which thi s person m ay not wri te medicat ion orders .
  10839   "^DD",200, 200,53.4,2 0,0)
  10840   ^.3LA^1^1
  10841   "^DD",200, 200,53.4,2 0,1,0)
  10842   PS
  10843   "^DD",200, 200,53.4,2 0,2,0)
  10844   PSO
  10845   "^DD",200, 200,53.4,2 1,0)
  10846   ^^2^2^2930 506^
  10847   "^DD",200, 200,53.4,2 1,1,0)
  10848   This field  is used t o show the  inactive  date of a  provider w hereas the y
  10849   "^DD",200, 200,53.4,2 1,2,0)
  10850   can no lon ger write  orders.
  10851   "^DD",200, 200,53.4,2 3,0)
  10852   ^^1^1^2970 204^^^
  10853   "^DD",200, 200,53.4,2 3,1,0)
  10854   date
  10855   "^DD",200, 200,53.4," DT")
  10856   2931020
  10857   "^DD",200, 200,53.5,0 )
  10858   PROVIDER C LASS^P7'^D IC(7,^PS;5 ^Q
  10859   "^DD",200, 200,53.5,1 ,0)
  10860   ^.1^^-1
  10861   "^DD",200, 200,53.5,1 ,2,0)
  10862   ^^TRIGGER^ 46.11^.03
  10863   "^DD",200, 200,53.5,1 ,2,1)
  10864   K DIV S DI V=X,D0=DA, DIV(0)=D0  S Y(0)=X S  X=$P($G(^ DG(43,1,"H L7")),U,4) =1 I X S X =DIV X ^DD (200,53.5, 1,2,89.2)  S Y(101)=$ S($D(^DGRU (46.11,D0, 0)):^(0),1 :"") S X=$ P(Y(101),U ,3) S D0=I (0,0) S DI U=X K Y S  X=DIV S X= 200 X ^DD( 200,53.5,1 ,2,1.4)
  10865   "^DD",200, 200,53.5,1 ,2,1.4)
  10866   S DIH=$S($ D(^DGRU(46 .11,DIV(0) ,0)):^(0), 1:""),DIV= X I $D(^(0 )) S $P(^( 0),U,3)=DI V,DIH=46.1 1,DIG=.03  D ^DICR:$O (^DD(DIH,D IG,1,0))>0
  10867   "^DD",200, 200,53.5,1 ,2,2)
  10868   Q
  10869   "^DD",200, 200,53.5,1 ,2,89.2)
  10870   S I(0,0)=$ S($D(D0):D 0,1:""),Y( 1)=$S($D(^ VA(200,D0, 0)):^(0),1 :"") S X=$ P(Y(1),U,1 ),X=X S X= X K DIC S  DIC="^DGRU (46.11,",D IC(0)="NMF L" D ^DIC  S (D,D0,DI V(0))=+Y
  10871   "^DD",200, 200,53.5,1 ,2,"%D",0)
  10872   ^^2^2^2991 018^
  10873   "^DD",200, 200,53.5,1 ,2,"%D",1, 0)
  10874   Trigger th e New Pers on file nu mber (#200 ) into the  RAI MDS M ONITOR
  10875   "^DD",200, 200,53.5,1 ,2,"%D",2, 0)
  10876   file whene ver the Ne w Person P rovider Cl ass is cha nged or ad ded.
  10877   "^DD",200, 200,53.5,1 ,2,"CREATE  CONDITION ")
  10878   S X=$P($G( ^DG(43,1," HL7")),U,4 )=1
  10879   "^DD",200, 200,53.5,1 ,2,"CREATE  VALUE")
  10880   S X=200
  10881   "^DD",200, 200,53.5,1 ,2,"DELETE  VALUE")
  10882   NO EFFECT
  10883   "^DD",200, 200,53.5,1 ,2,"DIC")
  10884   LOOKUP
  10885   "^DD",200, 200,53.5,1 ,2,"DT")
  10886   2991018
  10887   "^DD",200, 200,53.5,1 ,2,"FIELD" )
  10888   NAME:RAI M DS MONITOR :#.03
  10889   "^DD",200, 200,53.5,1 ,3,0)
  10890   ^^TRIGGER^ 46.11^.04
  10891   "^DD",200, 200,53.5,1 ,3,1)
  10892   K DIV S DI V=X,D0=DA, DIV(0)=D0  S Y(0)=X S  X=$P($G(^ DG(43,1,"H L7")),U,4) =1 I X S X =DIV X ^DD (200,53.5, 1,3,89.2)  S Y(101)=$ S($D(^DGRU (46.11,D0, 0)):^(0),1 :"") S X=$ P(Y(101),U ,4) S D0=I (0,0) S DI U=X K Y S  X=DIV S X= DA X ^DD(2 00,53.5,1, 3,1.4)
  10893   "^DD",200, 200,53.5,1 ,3,1.4)
  10894   S DIH=$S($ D(^DGRU(46 .11,DIV(0) ,0)):^(0), 1:""),DIV= X I $D(^(0 )) S $P(^( 0),U,4)=DI V,DIH=46.1 1,DIG=.04  D ^DICR:$O (^DD(DIH,D IG,1,0))>0
  10895   "^DD",200, 200,53.5,1 ,3,2)
  10896   Q
  10897   "^DD",200, 200,53.5,1 ,3,89.2)
  10898   S I(0,0)=$ S($D(D0):D 0,1:""),Y( 1)=$S($D(^ VA(200,D0, 0)):^(0),1 :"") S X=$ P(Y(1),U,1 ),X=X S X= X K DIC S  DIC="^DGRU (46.11,",D IC(0)="NMF " D ^DIC S  (D,D0,DIV (0))=+Y
  10899   "^DD",200, 200,53.5,1 ,3,"%D",0)
  10900   ^^1^1^2991 018^
  10901   "^DD",200, 200,53.5,1 ,3,"%D",1, 0)
  10902   Trigger th e internal  entry num ber of the  entry cha nged or ad ded into t he New Per son file,  into the R AI MDS MON ITOR file.
  10903   "^DD",200, 200,53.5,1 ,3,"CREATE  CONDITION ")
  10904   S X=$P($G( ^DG(43,1," HL7")),U,4 )=1
  10905   "^DD",200, 200,53.5,1 ,3,"CREATE  VALUE")
  10906   S X=DA
  10907   "^DD",200, 200,53.5,1 ,3,"DELETE  VALUE")
  10908   NO EFFECT
  10909   "^DD",200, 200,53.5,1 ,3,"DIC")
  10910   LOOKUP
  10911   "^DD",200, 200,53.5,1 ,3,"DT")
  10912   2991018
  10913   "^DD",200, 200,53.5,1 ,3,"FIELD" )
  10914   NAME:RAI M DS MONITOR :#.04
  10915   "^DD",200, 200,53.5,3 )
  10916   Enter prov ider class  of provid er (MD, PA  etc).
  10917   "^DD",200, 200,53.5,2 0,0)
  10918   ^.3LA^1^1
  10919   "^DD",200, 200,53.5,2 0,1,0)
  10920   PS
  10921   "^DD",200, 200,53.5,2 0,2,0)
  10922   PSO
  10923   "^DD",200, 200,53.5,2 1,0)
  10924   ^^1^1^2930 506^
  10925   "^DD",200, 200,53.5,2 1,1,0)
  10926   This field  is used t o show the  providers  class.
  10927   "^DD",200, 200,53.5," DT")
  10928   2991018
  10929   "^DD",200, 200,53.6,0 )
  10930   PROVIDER T YPE^S^1:FU LL TIME;2: PART TIME; 3:C & A;4: FEE BASIS; 5:HOUSE ST AFF;^PS;6^ Q
  10931   "^DD",200, 200,53.6,1 ,0)
  10932   ^.1^^0
  10933   "^DD",200, 200,53.6,3 )
  10934   Enter type  of provid er.
  10935   "^DD",200, 200,53.6,2 0,0)
  10936   ^.3LA^1^1
  10937   "^DD",200, 200,53.6,2 0,1,0)
  10938   PS
  10939   "^DD",200, 200,53.6,2 0,2,0)
  10940   PSO
  10941   "^DD",200, 200,53.6,2 1,0)
  10942   ^^1^1^2930 506^
  10943   "^DD",200, 200,53.6,2 1,1,0)
  10944   This field  is used t o show the  type of p rovider (s taff, fee,  etc.)
  10945   "^DD",200, 200,53.6,2 3,0)
  10946   ^^1^1^2920 930^^
  10947   "^DD",200, 200,53.6,2 3,1,0)
  10948   set of cod es.
  10949   "^DD",200, 200,53.6," DT")
  10950   2931208
  10951   "^DD",200, 200,53.7,0 )
  10952   REQUIRES C OSIGNER^S^ 1:YES;^PS; 7^Q
  10953   "^DD",200, 200,53.7,3 )
  10954   Enter yes  if medicat ion orders  written b y this per son must b e cosigned  by anothe r provider  of care.
  10955   "^DD",200, 200,53.7,2 0,0)
  10956   ^.3LA^1^1
  10957   "^DD",200, 200,53.7,2 0,1,0)
  10958   PS
  10959   "^DD",200, 200,53.7,2 0,2,0)
  10960   PSO
  10961   "^DD",200, 200,53.7,2 1,0)
  10962   ^^1^1^2930 506^
  10963   "^DD",200, 200,53.7,2 1,1,0)
  10964   This field  is used t o determin e if the p rovider ne eds a cosi gner.
  10965   "^DD",200, 200,53.7,2 3,0)
  10966   ^^1^1^2920 930^
  10967   "^DD",200, 200,53.7,2 3,1,0)
  10968   set of cod es.
  10969   "^DD",200, 200,53.7," DT")
  10970   2891012
  10971   "^DD",200, 200,53.8,0 )
  10972   USUAL COSI GNER^*P200 '^VA(200,^ PS;8^S DIC ("S")="I $ D(^(""PS"" )),$P(^("" PS""),""^" "),'$P(^(" "PS""),""^ "",7),$S(' $P(^(""PS" "),""^"",4 ):1,1:$P(^ (""PS"")," "^"",4)'<D T)" D ^DIC  K DIC S D IC=DIE,X=+ Y K:Y<0 X
  10973   "^DD",200, 200,53.8,3 )
  10974   Select cos igner.
  10975   "^DD",200, 200,53.8,1 2)
  10976   Only activ e provider s of care  who do not  themselve s require  a cosigner
  10977   "^DD",200, 200,53.8,1 2.1)
  10978   S DIC("S") ="I $D(^(" "PS"")),$P (^(""PS"") ,""^""),'$ P(^(""PS"" ),""^"",7) ,$S('$P(^( ""PS""),"" ^"",4):1,1 :$P(^(""PS ""),""^"", 4)'<DT)"
  10979   "^DD",200, 200,53.8,2 0,0)
  10980   ^.3LA^1^1
  10981   "^DD",200, 200,53.8,2 0,1,0)
  10982   PS
  10983   "^DD",200, 200,53.8,2 0,2,0)
  10984   PSO
  10985   "^DD",200, 200,53.8,2 1,0)
  10986   ^^1^1^2930 506^
  10987   "^DD",200, 200,53.8,2 1,1,0)
  10988   This field  is used t o show the  usual cos igner for  the provid er.
  10989   "^DD",200, 200,53.8,2 3,0)
  10990   ^^1^1^2920 930^
  10991   "^DD",200, 200,53.8,2 3,1,0)
  10992   pointer.
  10993   "^DD",200, 200,53.8," DT")
  10994   2891012
  10995   "^DD",200, 200,53.9,0 )
  10996   REMARKS^F^ ^PS;9^K:$L (X)>60!($L (X)<1) X
  10997   "^DD",200, 200,53.9,. 1)
  10998   REMARKS
  10999   "^DD",200, 200,53.9,3 )
  11000   Enter rema rks about  this provi der to be  displayed  when s/he  is selecte d during o rder entry .
  11001   "^DD",200, 200,53.9,2 0,0)
  11002   ^.3LA^1^1
  11003   "^DD",200, 200,53.9,2 0,1,0)
  11004   PS
  11005   "^DD",200, 200,53.9,2 0,2,0)
  11006   PSO
  11007   "^DD",200, 200,53.9,2 1,0)
  11008   ^^1^1^2920 930^
  11009   "^DD",200, 200,53.9,2 1,1,0)
  11010   This field  is used t o enter re marks and  or comment s about th e provider .
  11011   "^DD",200, 200,53.9,2 3,0)
  11012   ^^1^1^2920 930^
  11013   "^DD",200, 200,53.9,2 3,1,0)
  11014   free text
  11015   "^DD",200, 200,53.9," DT")
  11016   2891012
  11017   "^DD",200, 200,53.91, 0)
  11018   NON-VA PRE SCRIBER^S^ 1:YES;0:NO ;^TPB;1^Q
  11019   "^DD",200, 200,53.91, 21,0)
  11020   ^^6^6^3030 829^
  11021   "^DD",200, 200,53.91, 21,1,0)
  11022   The Transi tional Pha rmacy Care  Project ( TPB) intro duces fiel ds 53.91 -  
  11023   "^DD",200, 200,53.91, 21,2,0)
  11024   53.96, to  allow a NO N-VA Physi cian to be  added to  the New Pe rson file
  11025   "^DD",200, 200,53.91, 21,3,0)
  11026   (#200), so  that Outp atient Pha rmacy coul d process  medication  prescribe d by
  11027   "^DD",200, 200,53.91, 21,4,0)
  11028   such physi cians.
  11029   "^DD",200, 200,53.91, 21,5,0)
  11030    
  11031   "^DD",200, 200,53.91, 21,6,0)
  11032   A value of  1 indicat es that th is person  is a NON-V A Physicia n.
  11033   "^DD",200, 200,53.91, "DT")
  11034   3030829
  11035   "^DD",200, 200,53.92, 0)
  11036   TAX ID^F^^ TPB;2^K:$L (X)>10!($L (X)<10)!'( X?2N1"-"7N ) X
  11037   "^DD",200, 200,53.92, 3)
  11038   Answer mus t be 10 ch aracters i n length a nd should  be of the  format '99 -9999999'.
  11039   "^DD",200, 200,53.92, 21,0)
  11040   ^^2^2^3030 829^
  11041   "^DD",200, 200,53.92, 21,1,0)
  11042   TAX ID of  the NON-VA  Physician 's Private  Clinic, w here the p rescriptio n
  11043   "^DD",200, 200,53.92, 21,2,0)
  11044   was writte n.
  11045   "^DD",200, 200,53.92, "DT")
  11046   3030829
  11047   "^DD",200, 200,53.93, 0)
  11048   EXCLUSIONA RY CHECK P ERFORMED^S ^1:YES;^TP B;3^Q
  11049   "^DD",200, 200,53.93, 21,0)
  11050   ^^7^7^3030 829^
  11051   "^DD",200, 200,53.93, 21,1,0)
  11052   Department  of Health  and Human  Services  provides a n exclusio nary list  of
  11053   "^DD",200, 200,53.93, 21,2,0)
  11054   Medical Pr actitioner s (provide rs exclude d are thos e who are  not allowe d to
  11055   "^DD",200, 200,53.93, 21,3,0)
  11056   receive pa yment for  government  services  due to var ious reaso ns). When
  11057   "^DD",200, 200,53.93, 21,4,0)
  11058   adding NON -VA Physic ians, they  must be c hecked aga inst this  list.
  11059   "^DD",200, 200,53.93, 21,5,0)
  11060    
  11061   "^DD",200, 200,53.93, 21,6,0)
  11062   A value of  1 indicat es that an  Exclusion ary Check  was perfor med for th is
  11063   "^DD",200, 200,53.93, 21,7,0)
  11064   physician.
  11065   "^DD",200, 200,53.93, "DT")
  11066   3030829
  11067   "^DD",200, 200,53.94, 0)
  11068   DATE EXCLU SIONARY LI ST CHECKED ^D^^TPB;4^ S %DT="EX"  D ^%DT S  X=Y K:DT<X !(3030801> X) X
  11069   "^DD",200, 200,53.94, 3)
  11070   TYPE A DAT E BETWEEN  AUG 01, 20 03 AND CUR RENT DATE
  11071   "^DD",200, 200,53.94, 21,0)
  11072   ^^1^1^3030 822^
  11073   "^DD",200, 200,53.94, 21,1,0)
  11074   The date E xclusionar y Check wa s performe d.
  11075   "^DD",200, 200,53.94, "DT")
  11076   3030822
  11077   "^DD",200, 200,53.95, 0)
  11078   ON EXCLUSI ONARY LIST ^S^1:YES;0 :NO;^TPB;5 ^Q
  11079   "^DD",200, 200,53.95, 21,0)
  11080   ^^2^2^3030 904^
  11081   "^DD",200, 200,53.95, 21,1,0)
  11082   Was the NO N-VA Physi cian on th e Exclusio nary Check  List?
  11083   "^DD",200, 200,53.95, 21,2,0)
  11084   A value of  1 indicat es that th e Physicia n was on t he Exclusi onary Chec k.
  11085   "^DD",200, 200,53.95, "DT")
  11086   3030904
  11087   "^DD",200, 200,53.96, 0)
  11088   EXCLUSIONA RY CHECKED  BY^P200'^ VA(200,^TP B;6^Q
  11089   "^DD",200, 200,53.96, 21,0)
  11090   ^^1^1^3030 829^
  11091   "^DD",200, 200,53.96, 21,1,0)
  11092   User ID of  the perso n who made  the entry .
  11093   "^DD",200, 200,53.96, "DT")
  11094   3030829
  11095   "^DD",200, 200,54.1,0 )
  11096   LICENSING  STATE^200. 541P^^PS1; 0
  11097   "^DD",200, 200,54.1,2 0,0)
  11098   ^.3LA^1^1
  11099   "^DD",200, 200,54.1,2 0,1,0)
  11100   PS
  11101   "^DD",200, 200,54.1,2 0,2,0)
  11102   PSO
  11103   "^DD",200, 200,54.1,2 1,0)
  11104   ^^2^2^2930 506^
  11105   "^DD",200, 200,54.1,2 1,1,0)
  11106   This multi ple contai ns credent ialing inf ormation a bout a pro vider
  11107   "^DD",200, 200,54.1,2 1,2,0)
  11108   that is us ed by the  state.
  11109   "^DD",200, 200,54.1,2 3,0)
  11110   ^^1^1^2921 104^
  11111   "^DD",200, 200,54.1,2 3,1,0)
  11112   This mulit ple utiliz ed by the  Indian Hea lth Servic e
  11113   "^DD",200, 200,54.2,0 )
  11114   STATE ISSU ING DEA NU MBER^200.5 5P^^PS2;0
  11115   "^DD",200, 200,54.2,2 0,0)
  11116   ^.3LA^1^1
  11117   "^DD",200, 200,54.2,2 0,1,0)
  11118   PS
  11119   "^DD",200, 200,54.2,2 0,2,0)
  11120   PSO
  11121   "^DD",200, 200,54.2,2 1,0)
  11122   ^^2^2^2921 106^^
  11123   "^DD",200, 200,54.2,2 1,1,0)
  11124   This mutip le contain s the DEA#  issued by  a state i n order to  allow
  11125   "^DD",200, 200,54.2,2 1,2,0)
  11126   providers  to write m edication  orders for  controlle d medicati ons.
  11127   "^DD",200, 200,54.2,2 3,0)
  11128   ^^1^1^2921 106^^
  11129   "^DD",200, 200,54.2,2 3,1,0)
  11130   This multi ple is uti lized by t he Indian  Health Ser vice.
  11131   "^DD",200, 200,55.1,0 )
  11132   SCHEDULE I I NARCOTIC ^S^1:Yes;0 :No;^PS3;1 ^Q
  11133   "^DD",200, 200,55.1,3 )
  11134   Provider h as privile ges for sc hedule II  narcotic?
  11135   "^DD",200, 200,55.1,2 1,0)
  11136   ^.001^2^2^ 3120828^^^ ^
  11137   "^DD",200, 200,55.1,2 1,1,0)
  11138   This field  is used t o determin e if the p rovider ha s privileg es for 
  11139   "^DD",200, 200,55.1,2 1,2,0)
  11140   Schedule I I narcotic .
  11141   "^DD",200, 200,55.1," DT")
  11142   3111019
  11143   "^DD",200, 200,55.2,0 )
  11144   SCHEDULE I I NON-NARC OTIC^S^1:Y es;0:No;^P S3;2^Q
  11145   "^DD",200, 200,55.2,3 )
  11146   Provider h as privile ges for sc hedule II  non-narcot ic?
  11147   "^DD",200, 200,55.2,2 1,0)
  11148   ^.001^2^2^ 3111019^^^ ^
  11149   "^DD",200, 200,55.2,2 1,1,0)
  11150   This field  is used t o determin e if the p rovider ha s privileg es for 
  11151   "^DD",200, 200,55.2,2 1,2,0)
  11152   Schedule I I non-narc otic.
  11153   "^DD",200, 200,55.2," DT")
  11154   3111019
  11155   "^DD",200, 200,55.3,0 )
  11156   SCHEDULE I II NARCOTI C^S^1:Yes; 0:No;^PS3; 3^Q
  11157   "^DD",200, 200,55.3,3 )
  11158   Provider h as privile ges for sc hedule III  narcotic?
  11159   "^DD",200, 200,55.3,2 1,0)
  11160   ^.001^2^2^ 3111019^^^
  11161   "^DD",200, 200,55.3,2 1,1,0)
  11162   This field  is used t o determin e if the p rovider ha s privileg es for 
  11163   "^DD",200, 200,55.3,2 1,2,0)
  11164   Schedule I II narcoti c.
  11165   "^DD",200, 200,55.3," DT")
  11166   3111019
  11167   "^DD",200, 200,55.4,0 )
  11168   SCHEDULE I II NON-NAR COTIC^S^1: Yes;0:No;^ PS3;4^Q
  11169   "^DD",200, 200,55.4,3 )
  11170   Provider h as privile ges for sc hedule III  non-narco tic?
  11171   "^DD",200, 200,55.4,2 1,0)
  11172   ^.001^2^2^ 3111019^^^
  11173   "^DD",200, 200,55.4,2 1,1,0)
  11174   This field  is used t o determin e if the p rovider ha s privileg es for 
  11175   "^DD",200, 200,55.4,2 1,2,0)
  11176   Schedule I II non-nar cotic.
  11177   "^DD",200, 200,55.4," DT")
  11178   3111019
  11179   "^DD",200, 200,55.5,0 )
  11180   SCHEDULE I V^S^1:Yes; 0:No;^PS3; 5^Q
  11181   "^DD",200, 200,55.5,3 )
  11182   Provider h as privile ges for sc hedule IV?
  11183   "^DD",200, 200,55.5,2 1,0)
  11184   ^.001^2^2^ 3111019^^^
  11185   "^DD",200, 200,55.5,2 1,1,0)
  11186   This field  is used t o determin e if the p rovider ha s privileg es for 
  11187   "^DD",200, 200,55.5,2 1,2,0)
  11188   Schedule I V controll ed substan ces.
  11189   "^DD",200, 200,55.5," DT")
  11190   3111019
  11191   "^DD",200, 200,55.6,0 )
  11192   SCHEDULE V ^S^1:Yes;0 :No;^PS3;6 ^Q
  11193   "^DD",200, 200,55.6,3 )
  11194   Provider h as privile ges for sc hedule V?
  11195   "^DD",200, 200,55.6,2 1,0)
  11196   ^.001^2^2^ 3111019^^
  11197   "^DD",200, 200,55.6,2 1,1,0)
  11198   This field  is used t o determin e if the p rovider ha s privileg es for 
  11199   "^DD",200, 200,55.6,2 1,2,0)
  11200   Schedule V  controlle d substanc es.
  11201   "^DD",200, 200,55.6," DT")
  11202   3111019
  11203   "^DD",200, 200,70,0)
  11204   STAFF REVI EW REQUIRE D^S^Y:yes; N:no;^RA;1 ^Q
  11205   "^DD",200, 200,70,10)
  11206   RAD/NUC ME D COORDINA TOR
  11207   "^DD",200, 200,70,21, 0)
  11208   ^^3^3^2941 228^^
  11209   "^DD",200, 200,70,21, 1,0)
  11210   This field  applies t o 'Interpr eting Resi dent' pers onnel. If
  11211   "^DD",200, 200,70,21, 2,0)
  11212   it contain s a 'yes',  an interp reting sta ff is requ ired to
  11213   "^DD",200, 200,70,21, 3,0)
  11214   review thi s resident 's report  results.
  11215   "^DD",200, 200,70,"DT ")
  11216   2900207
  11217   "^DD",200, 200,71,0)
  11218   ALLOW VERI FYING OF O THERS^S^y: YES;n:NO;^ RA;2^Q
  11219   "^DD",200, 200,71,10)
  11220   RAD/NUC ME D COORDINA TOR
  11221   "^DD",200, 200,71,21, 0)
  11222   ^^14^14^29 70205^
  11223   "^DD",200, 200,71,21, 1,0)
  11224   If this fi eld is set  to 'YES'  and the 'A LLOW VERIF YING BY RE SIDENTS'
  11225   "^DD",200, 200,71,21, 2,0)
  11226   division p arameter i s also set  to 'YES'  then this  resident i s allowed  to
  11227   "^DD",200, 200,71,21, 3,0)
  11228   verify rep orts assoc iated with  another i nterpretin g physicia n.  (If bo th
  11229   "^DD",200, 200,71,21, 4,0)
  11230   parameters  are set t o 'YES' th e 'On-line  Verifying  of Report s' option  will
  11231   "^DD",200, 200,71,21, 5,0)
  11232   prompt the  user to ' Select Int erpreting  Physician:  ' allowin g the user  to
  11233   "^DD",200, 200,71,21, 6,0)
  11234   select an  interpreti ng physici an other t han him/he rself.) If  this fiel d is
  11235   "^DD",200, 200,71,21, 7,0)
  11236   set to 'NO ' then thi s resident  is only a llowed to  verify his /her own
  11237   "^DD",200, 200,71,21, 8,0)
  11238   reports.   If the div ision para meter 'ALL OW VERIFYI NG BY RESI DENT' is s et
  11239   "^DD",200, 200,71,21, 9,0)
  11240   to 'NO' th en regardl ess of how  this fiel d is set,  the reside nt will no t be
  11241   "^DD",200, 200,71,21, 10,0)
  11242   allowed to  verify ot her interp reting phy sicians' r eports.
  11243   "^DD",200, 200,71,21, 11,0)
  11244    
  11245   "^DD",200, 200,71,21, 12,0)
  11246   If the use r is class ified as I nterpretin g Staff, s /he will b e allowed  to
  11247   "^DD",200, 200,71,21, 13,0)
  11248   select ano ther inter preting ph ysician's  name and r eports if  this field  is
  11249   "^DD",200, 200,71,21, 14,0)
  11250   set to 'YE S'.
  11251   "^DD",200, 200,71,"DT ")
  11252   2900207
  11253   "^DD",200, 200,72,0)
  11254   RAD/NUC ME D CLASSIFI CATION^200 .072S^^RAC ;0
  11255   "^DD",200, 200,72,21, 0)
  11256   ^^3^3^2971 202^^^^
  11257   "^DD",200, 200,72,21, 1,0)
  11258   This multi ple field  contains i nformation  about the  classific ation assi gned
  11259   "^DD",200, 200,72,21, 2,0)
  11260   to Rad/Nuc  Med perso nnel.  Pos sible clas sification s are Tech nologist,
  11261   "^DD",200, 200,72,21, 3,0)
  11262   Interpreti ng Residen t, Interpr eting Staf f, and Cle rk.
  11263   "^DD",200, 200,72,"DT ")
  11264   2941104
  11265   "^DD",200, 200,73,0)
  11266   RAD/NUC ME D INACTIVE  DATE^D^^R A;3^S %DT= "EX" D ^%D T S X=Y K: Y<1 X
  11267   "^DD",200, 200,73,21, 0)
  11268   ^^2^2^2941 228^^
  11269   "^DD",200, 200,73,21, 1,0)
  11270   This field  contains  the date t hat this p erson was  inactivate d as a Rad /Nuc
  11271   "^DD",200, 200,73,21, 2,0)
  11272   Med user.
  11273   "^DD",200, 200,73,"DT ")
  11274   2941104
  11275   "^DD",200, 200,74,0)
  11276   RAD/NUC ME D LOCATION  ACCESS^20 0.074P^^RA L;0
  11277   "^DD",200, 200,74,21, 0)
  11278   ^^2^2^2971 202^^^^
  11279   "^DD",200, 200,74,21, 1,0)
  11280   This field  will allo w the user  to access  all data  specific t o a partic ular
  11281   "^DD",200, 200,74,21, 2,0)
  11282   Radiology/ Nuclear Me dicine loc ation.
  11283   "^DD",200, 200,74,"DT ")
  11284   2941104
  11285   "^DD",200, 200,101.01 ,0)
  11286   RESTRICT P ATIENT SEL ECTION^S^0 :NO;1:YES; ^101;1^Q
  11287   "^DD",200, 200,101.01 ,21,0)
  11288   ^^3^3^3011 029^
  11289   "^DD",200, 200,101.01 ,21,1,0)
  11290   Answer 'YE S' to rest rict this  user to se lecting on ly those p atients
  11291   "^DD",200, 200,101.01 ,21,2,0)
  11292   associated  with the  list point ed to by t he PATIENT  SELECTION  LIST fiel d
  11293   "^DD",200, 200,101.01 ,21,3,0)
  11294   (#101.02).
  11295   "^DD",200, 200,101.01 ,"DT")
  11296   3011019
  11297   "^DD",200, 200,101.02 ,0)
  11298   PATIENT SE LECTION LI ST^*P100.2 1'^OR(100. 21,^101;2^ S DIC("S") ="I $P($G( ^(0)),U,2) '=""P""" D  ^DIC K DI C S DIC=DI E,X=+Y K:Y <0 X
  11299   "^DD",200, 200,101.02 ,12)
  11300   You cannot  select a  personal-t ype list.
  11301   "^DD",200, 200,101.02 ,12.1)
  11302   S DIC("S") ="I $P($G( ^(0)),U,2) '=""P"""
  11303   "^DD",200, 200,101.02 ,21,0)
  11304   ^.001^2^2^ 3020322^^
  11305   "^DD",200, 200,101.02 ,21,1,0)
  11306   If a value  is entere d into thi s field, t he user is  allowed t o select o nly
  11307   "^DD",200, 200,101.02 ,21,2,0)
  11308   those pati ents assoc iated with  this OE/R R LIST.
  11309   "^DD",200, 200,101.02 ,"DT")
  11310   3020322
  11311   "^DD",200, 200,101.13 ,0)
  11312   CPRS TAB^2 00.010113P OI^^ORD;0
  11313   "^DD",200, 200,125,0)
  11314   PROBLEM LI ST PRIMARY  VIEW^F^^1 25;1^K:$L( X)>210!($L (X)<3) X
  11315   "^DD",200, 200,125,3)
  11316   Answer mus t be 3-210  character s in lengt h.
  11317   "^DD",200, 200,125,21 ,0)
  11318   ^^4^4^2931 001^^^^
  11319   "^DD",200, 200,125,21 ,1,0)
  11320   This strin g contains  the user' s preferre d view of  the proble m list.
  11321   "^DD",200, 200,125,21 ,2,0)
  11322   Problems a re assigne d a catego ry based u pon the se rvice of t he provide r
  11323   "^DD",200, 200,125,21 ,3,0)
  11324   who entere d and/or i s treating  the probl em; a scre en may the n be invok ed
  11325   "^DD",200, 200,125,21 ,4,0)
  11326   allowing a  filtered  view of th e problem  list.
  11327   "^DD",200, 200,125,23 ,0)
  11328   ^^4^4^2931 001^^^^
  11329   "^DD",200, 200,125,23 ,1,0)
  11330   This strin g should b e in the f ormat '/#/ #/.../#/'  where each  # is a
  11331   "^DD",200, 200,125,23 ,2,0)
  11332   pointer to  an entry  in the Ser vice/Secti on file (# 49).  The  option
  11333   "^DD",200, 200,125,23 ,3,0)
  11334   GMPL USER  VIEW is ex ported wit h the Prob lem List a pplication  to facili tate
  11335   "^DD",200, 200,125,23 ,4,0)
  11336   building t his string ; its use  is recomme nded.
  11337   "^DD",200, 200,125,"D T")
  11338   2930512
  11339   "^DD",200, 200,125.1, 0)
  11340   PROBLEM SE LECTION LI ST^P125'^G MPL(125,^1 25;2^Q
  11341   "^DD",200, 200,125.1, 3)
  11342   Enter the  list of pr oblems you  wish disp layed to s elect from , when add ing to a p atient's p roblem lis t.
  11343   "^DD",200, 200,125.1, 21,0)
  11344   ^^6^6^2931 110^^
  11345   "^DD",200, 200,125.1, 21,1,0)
  11346   This is th e user's p referred d efault lis t of probl ems to sel ect from
  11347   "^DD",200, 200,125.1, 21,2,0)
  11348   when addin g to a pat ient's pro blem list.   If there  is a list  specified
  11349   "^DD",200, 200,125.1, 21,3,0)
  11350   here from  the Proble m Selectio n List Fil e (#125),  it will be  automatic ally
  11351   "^DD",200, 200,125.1, 21,4,0)
  11352   presented  to the use r when the  "Add New  Problem(s) " action i s selected ;
  11353   "^DD",200, 200,125.1, 21,5,0)
  11354   otherwise,  the user  will simpl y be promp ted to sel ect a prob lem from
  11355   "^DD",200, 200,125.1, 21,6,0)
  11356   the Clinic al Lexicon  Utility.
  11357   "^DD",200, 200,125.1, "DT")
  11358   2931110
  11359   "^DD",200, 200,200.04 ,0)
  11360   MULTIPLE S IGN-ON^S^0 :NOT ALLOW ED;1:ALLOW ED;2:Only  one IP;^20 0;4^Q
  11361   "^DD",200, 200,200.04 ,3)
  11362   Answer '0'  to limit  this USER  to ONE con nection, ' 2' will li mit USER t o one work station.
  11363   "^DD",200, 200,200.04 ,21,0)
  11364   ^^9^9^3030 130^
  11365   "^DD",200, 200,200.04 ,21,1,0)
  11366   This field , if fille d in, over rides the  SITE and D EVICE File s as to
  11367   "^DD",200, 200,200.04 ,21,2,0)
  11368   whether th is user ca n sign-on  to multipl e terminal s at the s ame time, 
  11369   "^DD",200, 200,200.04 ,21,3,0)
  11370   or is limi ted to one  workstati on (IP), o nly one co nnection.
  11371   "^DD",200, 200,200.04 ,21,4,0)
  11372   If you sel ect "Only  one IP" be  sure to p ut a value  into the  "MULTIPLE
  11373   "^DD",200, 200,200.04 ,21,5,0)
  11374   SIGN-ON LI MIT" field  so users  can sign-o n at least  once.
  11375   "^DD",200, 200,200.04 ,21,6,0)
  11376   Values are :
  11377   "^DD",200, 200,200.04 ,21,7,0)
  11378   0 = Only o ne connect ion.
  11379   "^DD",200, 200,200.04 ,21,8,0)
  11380   1 = Multip le connect ions from  multiple I P's.
  11381   "^DD",200, 200,200.04 ,21,9,0)
  11382   2 = Only o ne IP addr ess.
  11383   "^DD",200, 200,200.04 ,"DT")
  11384   3030130
  11385   "^DD",200, 200,200.05 ,0)
  11386   ASK DEVICE  TYPE AT S IGN-ON^S^1 :ASK;0:DON 'T ASK;^20 0;5^Q
  11387   "^DD",200, 200,200.05 ,21,0)
  11388   ^^5^5^2920 702^
  11389   "^DD",200, 200,200.05 ,21,1,0)
  11390   This field  controls  if the use r/terminal  should be  asked for  a termina l
  11391   "^DD",200, 200,200.05 ,21,2,0)
  11392   type durin g sign-on.  If set to  YES then  the system  will try  and get th e
  11393   "^DD",200, 200,200.05 ,21,3,0)
  11394   terminal t ype from t he termina l. If this  doesn't w ork, then  user is
  11395   "^DD",200, 200,200.05 ,21,4,0)
  11396   prompted.  If set to  NO then th e one from  the users  Last Sign -on field  or
  11397   "^DD",200, 200,200.05 ,21,5,0)
  11398   the device  subtype w ill be use d.
  11399   "^DD",200, 200,200.05 ,23,0)
  11400   ^^8^8^2920 702^
  11401   "^DD",200, 200,200.05 ,23,1,0)
  11402   This field  (if fille d in) will  override  the ones i n the KERN EL site
  11403   "^DD",200, 200,200.05 ,23,2,0)
  11404   parameter  file. It c ontrols if  the user/ terminal s hould be a sked for a
  11405   "^DD",200, 200,200.05 ,23,3,0)
  11406   terminal t ype during  sign-on.
  11407   "^DD",200, 200,200.05 ,23,4,0)
  11408   If set to  YES then a  ANSI DA i s sent to  the termin al to coll ect the
  11409   "^DD",200, 200,200.05 ,23,5,0)
  11410   terminals  DEVICE ATT RIBUTES me ssage. If  it is a kn ow one the n the term inal
  11411   "^DD",200, 200,200.05 ,23,6,0)
  11412   type is se t to this.  Otherwise  the user  is prompte d.
  11413   "^DD",200, 200,200.05 ,23,7,0)
  11414   If set to  NO then th e one from  the Last  Sign-on fi eld or dev ice subtyp e
  11415   "^DD",200, 200,200.05 ,23,8,0)
  11416   will be us ed.
  11417   "^DD",200, 200,200.05 ,"DT")
  11418   2880222
  11419   "^DD",200, 200,200.06 ,0)
  11420   AUTO MENU^ S^0:NO MEN US GENERAT ED;1:YES,  MENUS GENE RATED;^200 ;6^Q
  11421   "^DD",200, 200,200.06 ,21,0)
  11422   ^^2^2^2851 218^^^^
  11423   "^DD",200, 200,200.06 ,21,1,0)
  11424   This field  controls  whether th e user wil l see menu s automati cally
  11425   "^DD",200, 200,200.06 ,21,2,0)
  11426   displayed  (as if he  had typed  a "?") eac h time a n ew option  is present ed.
  11427   "^DD",200, 200,200.07 ,0)
  11428   LANGUAGE^P .85'^DI(.8 5,^200;7^Q
  11429   "^DD",200, 200,200.07 ,21,0)
  11430   ^^3^3^2940 524^
  11431   "^DD",200, 200,200.07 ,21,1,0)
  11432   The value  in this fi eld replac es the Def ault Langu age field  in the
  11433   "^DD",200, 200,200.07 ,21,2,0)
  11434   Kernel Sit e Paramete rs file.   It points  to the Lan guage file
  11435   "^DD",200, 200,200.07 ,21,3,0)
  11436   for the VA  FileMan D ialog file .
  11437   "^DD",200, 200,200.07 ,"DT")
  11438   2940524
  11439   "^DD",200, 200,200.08 ,0)
  11440   RESERVED^F ^^XUS;8^K: $L(X)>1!($ L(X)<1) X
  11441   "^DD",200, 200,200.08 ,3)
  11442   Answer mus t be 1 cha racter in  length.
  11443   "^DD",200, 200,200.08 ,21,0)
  11444   ^^1^1^2940 527^
  11445   "^DD",200, 200,200.08 ,21,1,0)
  11446   Place hold er, see fi le 3.5 #51 .8
  11447   "^DD",200, 200,200.08 ,"DT")
  11448   2940527
  11449   "^DD",200, 200,200.09 ,0)
  11450   TYPE-AHEAD ^S^Y:ALLOW ED;N:NOT A LLOWED;^20 0;9^Q
  11451   "^DD",200, 200,200.09 ,1,0)
  11452   ^.1
  11453   "^DD",200, 200,200.09 ,1,1,0)
  11454   200^AB2^MU MPS
  11455   "^DD",200, 200,200.09 ,1,1,1)
  11456   X:DA=DUZ ^ %ZOSF($S(X ="Y":"",1: "NO-")_"TY PE-AHEAD")
  11457   "^DD",200, 200,200.09 ,1,1,2)
  11458   I 1
  11459   "^DD",200, 200,200.09 ,1,1,"%D", 0)
  11460   ^^1^1^2910 521^
  11461   "^DD",200, 200,200.09 ,1,1,"%D", 1,0)
  11462   If the use r edits th em self, C hanges the re type-ah ead.
  11463   "^DD",200, 200,200.09 ,1,1,"DT")
  11464   2910521
  11465   "^DD",200, 200,200.09 ,3)
  11466   ANSWER 'Y'  IF USER C AN TYPE AN SWERS BEFO RE HE SEES  THE QUEST IONS!
  11467   "^DD",200, 200,200.09 ,21,0)
  11468   ^^4^4^2851 003^^^
  11469   "^DD",200, 200,200.09 ,21,1,0)
  11470   If type ah ead is sel ected, the  user will  be able t o type tex t ahead
  11471   "^DD",200, 200,200.09 ,21,2,0)
  11472   of what th e computer  is actual ly reading .  The com puter stor es the
  11473   "^DD",200, 200,200.09 ,21,3,0)
  11474   keystrokes  from the  user, whic h may be c onfusing i f the comp uter is sl ow
  11475   "^DD",200, 200,200.09 ,21,4,0)
  11476   but more e fficient i f the user  is carefu l.
  11477   "^DD",200, 200,200.09 ,"DT")
  11478   2910521
  11479   "^DD",200, 200,200.1, 0)
  11480   TIMED READ  (# OF SEC ONDS)^NJ4, 0a^^200;10 ^K:+X'=X!( X>1800)!(X <1)!(X?.E1 "."1N.N) X
  11481   "^DD",200, 200,200.1, 3)
  11482   Type a Num ber betwee n 1 and 18 00, 0 Deci mal Digits
  11483   "^DD",200, 200,200.1, 21,0)
  11484   ^.001^2^2^ 3100803^^^ ^
  11485   "^DD",200, 200,200.1, 21,1,0)
  11486   This field , if fille d in, over rides the  SITE and D EVICE file s as to
  11487   "^DD",200, 200,200.1, 21,2,0)
  11488   the time t his user h as to resp ond to a t imed read.   Stored i n DTIME.
  11489   "^DD",200, 200,200.1, "AUDIT")
  11490   e
  11491   "^DD",200, 200,200.1, "DT")
  11492   3050916
  11493   "^DD",200, 200,200.11 ,0)
  11494   ALWAYS SHO W SECONDAR IES^S^1:YE S;^200;11^ Q
  11495   "^DD",200, 200,200.11 ,3)
  11496   Enter 1 or  YES if th e secondar y menus sh ould alway s be shown  for this  user
  11497   "^DD",200, 200,200.11 ,21,0)
  11498   ^^2^2^2930 330^
  11499   "^DD",200, 200,200.11 ,21,1,0)
  11500   This field  is a flag  used by t he menu sy stem to co ntrol if
  11501   "^DD",200, 200,200.11 ,21,2,0)
  11502   the user i s shown th ere second ary menu l ist with o ne '?' or  two.
  11503   "^DD",200, 200,200.11 ,"DT")
  11504   2900123
  11505   "^DD",200, 200,200.18 ,0)
  11506   AUTO SIGN- ON^S^0:No; 1:Yes;^200 ;18^Q
  11507   "^DD",200, 200,200.18 ,21,0)
  11508   ^^2^2^2970 303^
  11509   "^DD",200, 200,200.18 ,21,1,0)
  11510   This field  will cont rol if the  Auto Sign -on (Singl e Sign-on)  is enable d
  11511   "^DD",200, 200,200.18 ,21,2,0)
  11512   for use wi th termina l sessions .
  11513   "^DD",200, 200,200.18 ,"DT")
  11514   2970303
  11515   "^DD",200, 200,200.19 ,0)
  11516   MULTIPLE S IGN-ON LIM IT^NJ3,0^^ 200;19^K:+ X'=X!(X>10 0)!(X<1)!( X?.E1"."1N .N) X
  11517   "^DD",200, 200,200.19 ,.1)
  11518   Multiple S ign-on Lim it
  11519   "^DD",200, 200,200.19 ,3)
  11520   Type a Num ber betwee n 1 and 10 0, 0 Decim al Digits
  11521   "^DD",200, 200,200.19 ,21,0)
  11522   ^^4^4^3021 021^
  11523   "^DD",200, 200,200.19 ,21,1,0)
  11524   This field , if fille d in, over rides the  SITE file.  This fiel d sets an
  11525   "^DD",200, 200,200.19 ,21,2,0)
  11526   upper limi t on the n umber of c oncurrent  sessions t hat this u ser can ha ve
  11527   "^DD",200, 200,200.19 ,21,3,0)
  11528   from one I P address  when the M ultiple Si gn-on fiel d (#204) i s set to " One
  11529   "^DD",200, 200,200.19 ,21,4,0)
  11530   IP"
  11531   "^DD",200, 200,200.19 ,"DT")
  11532   3021021
  11533   "^DD",200, 200,201,0)
  11534   PRIMARY ME NU OPTION^ *P19'Xa^DI C(19,^201; 1^S DIC("S ")="I $D(^ XUSEC(""XU MGR"",DUZ) )!$D(^VA(2 00,DUZ,19. 5,+Y,0))"  D ^DIC K D IC S DIC=D IE,X=+Y K: Y<0 X
  11535   "^DD",200, 200,201,1, 0)
  11536   ^.1
  11537   "^DD",200, 200,201,1, 1,0)
  11538   200^AP
  11539   "^DD",200, 200,201,1, 1,1)
  11540   S ^VA(200, "AP",$E(X, 1,30),DA)= ""
  11541   "^DD",200, 200,201,1, 1,2)
  11542   K ^VA(200, "AP",$E(X, 1,30),DA)
  11543   "^DD",200, 200,201,1, 2,0)
  11544   200^AI^MUM PS
  11545   "^DD",200, 200,201,1, 2,1)
  11546   D REDOXP^X Q7 Q
  11547   "^DD",200, 200,201,1, 2,2)
  11548   Q
  11549   "^DD",200, 200,201,1, 2,3)
  11550   This x-ref  is used t o facilita te microsu rgery of t he compile d menu tre es.
  11551   "^DD",200, 200,201,1, 2,"%D",0)
  11552   ^^4^4^2930 303^
  11553   "^DD",200, 200,201,1, 2,"%D",1,0 )
  11554   This cross -reference  causes a  node to be  set in th e "AT" cro ss-referen ce
  11555   "^DD",200, 200,201,1, 2,"%D",2,0 )
  11556   of file 19 , if there  is not cu rrently a  "P" node f or this op tion numbe r
  11557   "^DD",200, 200,201,1, 2,"%D",3,0 )
  11558   in ^XUTL(" XQO","Pnum ",    so t hat a tree  will be b uilt for t his primar y
  11559   "^DD",200, 200,201,1, 2,"%D",4,0 )
  11560   menu.
  11561   "^DD",200, 200,201,1, 2,"DT")
  11562   2930303
  11563   "^DD",200, 200,201,1, 3,0)
  11564   200^AF^MUM PS
  11565   "^DD",200, 200,201,1, 3,1)
  11566   D CONTCL^X USTERM1(DA )
  11567   "^DD",200, 200,201,1, 3,2)
  11568   D CONTCL^X USTERM1(DA )
  11569   "^DD",200, 200,201,1, 3,3)
  11570   Clear Cont inue
  11571   "^DD",200, 200,201,1, 3,"%D",0)
  11572   ^.101^3^3^ 3020725^^^
  11573   "^DD",200, 200,201,1, 3,"%D",1,0 )
  11574   This X-ref  calls cod e to clear  the follo wing field s  LAST OP TION ACCES SED
  11575   "^DD",200, 200,201,1, 3,"%D",2,0 )
  11576   (202.1) an d LAST OPT ION MAIN M ENU (202.2 ). This is  too keep  users from
  11577   "^DD",200, 200,201,1, 3,"%D",3,0 )
  11578   getting as ked to con tinue if t here menu  has change d.
  11579   "^DD",200, 200,201,1, 3,"DT")
  11580   3020411
  11581   "^DD",200, 200,201,3)
  11582   IF NO PRIM ARY MENU F OR TERMINA L, SIGN-ON  WILL BRAN CH TO THIS  OPTION
  11583   "^DD",200, 200,201,12 )
  11584   Can only b e edited b y Site man ager staff  or SMD us er.
  11585   "^DD",200, 200,201,12 .1)
  11586   S DIC("S") ="I $D(^XU SEC(""XUMG R"",DUZ))! $D(^VA(200 ,DUZ,19.5, +Y,0))"
  11587   "^DD",200, 200,201,21 ,0)
  11588   ^.001^3^3^ 3080123^^^ ^
  11589   "^DD",200, 200,201,21 ,1,0)
  11590   This is th e menu opt ion that t his user w ill be dro pped into
  11591   "^DD",200, 200,201,21 ,2,0)
  11592   if none of  the follo wing are s et: (in th e order ch ecked)
  11593   "^DD",200, 200,201,21 ,3,0)
  11594   Tied routi ne, Device  primary m enu.
  11595   "^DD",200, 200,201,"A UDIT")
  11596   e
  11597   "^DD",200, 200,201,"D T")
  11598   3020411
  11599   "^DD",200, 200,201.1, 0)
  11600   PRIMARY WI NDOW^P19'^ DIC(19,^20 1;2^Q
  11601   "^DD",200, 200,201.1, 21,0)
  11602   ^^1^1^2941 108^
  11603   "^DD",200, 200,201.1, 21,1,0)
  11604   This is th e lead or  first wind ow launche d at start up.
  11605   "^DD",200, 200,201.1, "DT")
  11606   2941108
  11607   "^DD",200, 200,201.2, 0)
  11608   STARTUP DE FAULT^S^M: Primary Me nu Option; W:Primary  Window;^20 1;3^Q
  11609   "^DD",200, 200,201.2, 3)
  11610   Should the  user be s tarted wit h the Prim ary Menu O ption or t he Primary  Window?
  11611   "^DD",200, 200,201.2, 21,0)
  11612   ^^2^2^2941 110^
  11613   "^DD",200, 200,201.2, 21,1,0)
  11614   This field  determine s if the P rimary Men u or the P rimary Win dow is
  11615   "^DD",200, 200,201.2, 21,2,0)
  11616   loaded at  logon.
  11617   "^DD",200, 200,201.2, "DT")
  11618   2941108
  11619   "^DD",200, 200,202,0)
  11620   LAST SIGN- ON DATE/TI ME^DI^^1.1 ;1^S %DT=" EST" D ^%D T S X=Y K: Y<1 X
  11621   "^DD",200, 200,202,21 ,0)
  11622   ^^1^1^2910 322^
  11623   "^DD",200, 200,202,21 ,1,0)
  11624   This field  is set wh en a user  signs on t o the syst em.
  11625   "^DD",200, 200,202,23 ,0)
  11626   ^^1^1^2910 322^
  11627   "^DD",200, 200,202,23 ,1,0)
  11628   This field  is set in  XUS1.  It  has been  moved from  XMB(3.7,D UZ,.1)
  11629   "^DD",200, 200,202,"D T")
  11630   3010516
  11631   "^DD",200, 200,202.02 ,0)
  11632   XUS Logon  Attempt Co unt^NJ2,0^ ^1.1;2^K:+ X'=X!(X>99 )!(X<0)!(X ?.E1"."1N. N) X
  11633   "^DD",200, 200,202.02 ,3)
  11634   Type a Num ber betwee n 0 and 99 , 0 Decima l Digits
  11635   "^DD",200, 200,202.02 ,21,0)
  11636   ^^1^1^2960 404^
  11637   "^DD",200, 200,202.02 ,21,1,0)
  11638   This is us ed to let  the user k now about  unsuccessf ul logon a tempts.
  11639   "^DD",200, 200,202.02 ,"DT")
  11640   2981208
  11641   "^DD",200, 200,202.03 ,0)
  11642   XUS Active  User^S^0: No;1:Yes;^ 1.1;3^Q
  11643   "^DD",200, 200,202.03 ,21,0)
  11644   ^^3^3^2960 404^
  11645   "^DD",200, 200,202.03 ,21,1,0)
  11646   If a user  gets the * * MULTIPUL E SIGN-ON  NOT ALLOWE D ** messa ge
  11647   "^DD",200, 200,202.03 ,21,2,0)
  11648   this field  can be se t to NO to  allow the m to sign- on again.
  11649   "^DD",200, 200,202.03 ,21,3,0)
  11650   This flag  is set by  XUS and XU SCLEAN.
  11651   "^DD",200, 200,202.03 ,"DT")
  11652   2960404
  11653   "^DD",200, 200,202.04 ,0)
  11654   Entry Last  Edit Date ^DI^^1.1;4 ^S %DT="ES TX" D ^%DT  S X=Y K:X <1 X
  11655   "^DD",200, 200,202.04 ,3)
  11656   (No range  limit on d ate)
  11657   "^DD",200, 200,202.04 ,5,1,0)
  11658   200^2^3
  11659   "^DD",200, 200,202.04 ,5,2,0)
  11660   200^7^1
  11661   "^DD",200, 200,202.04 ,5,3,0)
  11662   200^9.2^2
  11663   "^DD",200, 200,202.04 ,21,0)
  11664   ^^3^3^3010 927^
  11665   "^DD",200, 200,202.04 ,21,1,0)
  11666   This field  holds the  date time  this entr y in the f ile was la st edited.
  11667   "^DD",200, 200,202.04 ,21,2,0)
  11668   The follow ing fields  now trigg er the cur rent date  to the ENT RY LAST ED IT
  11669   "^DD",200, 200,202.04 ,21,3,0)
  11670   DATE field : DISUSER  (#7), ACCE SS CODE (# 2), and TE RMINATION  DATE (#9.2 ). 
  11671   "^DD",200, 200,202.04 ,"DT")
  11672   3010927
  11673   "^DD",200, 200,202.05 ,0)
  11674   LOCKOUT US ER UNTIL^D ^^1.1;5^S  %DT="ESTX"  D ^%DT S  X=Y K:Y<1  X
  11675   "^DD",200, 200,202.05 ,21,0)
  11676   ^^4^4^3040 121^
  11677   "^DD",200, 200,202.05 ,21,1,0)
  11678   This field  is used b y the sign on code to  lockout u sers that  have
  11679   "^DD",200, 200,202.05 ,21,2,0)
  11680   tried bad  VERIFY cod es too man y times.   This field  holds the  date/time  
  11681   "^DD",200, 200,202.05 ,21,3,0)
  11682   that the u ser should  be locked  out of th e system u ntil.
  11683   "^DD",200, 200,202.05 ,21,4,0)
  11684   It is set  with the c urrent tim e plus the  lockout t ime.
  11685   "^DD",200, 200,202.05 ,"DT")
  11686   3040121
  11687   "^DD",200, 200,202.1, 0)
  11688   LAST OPTIO N ACCESSED ^P19'I^DIC (19,^202.1 ;1^Q
  11689   "^DD",200, 200,202.1, 9)
  11690   ^
  11691   "^DD",200, 200,202.1, 21,0)
  11692   ^^3^3^2860 729^^^
  11693   "^DD",200, 200,202.1, 21,1,0)
  11694   This field  holds the  last opti on accesse d by the u ser, when  the user
  11695   "^DD",200, 200,202.1, 21,2,0)
  11696   selects th e CONTINUE  option in stead of H ALTing.  W hen the us er logs
  11697   "^DD",200, 200,202.1, 21,3,0)
  11698   on again,  he will be  able to c ontinue di rectly at  that optio n.
  11699   "^DD",200, 200,202.2, 0)
  11700   LAST OPTIO N MAIN MEN U^FI^^202. 1;2^K:$L(X )>10!($L(X )<1) X
  11701   "^DD",200, 200,202.2, 3)
  11702   ANSWER MUS T BE 1-10  CHARACTERS  IN LENGTH
  11703   "^DD",200, 200,202.2, 9)
  11704   ^
  11705   "^DD",200, 200,202.2, 21,0)
  11706   ^^4^4^2860 729^
  11707   "^DD",200, 200,202.2, 21,1,0)
  11708   This field  holds an  indicator  of which p rimary or  secondary  menu a
  11709   "^DD",200, 200,202.2, 21,2,0)
  11710   user was i n, after s electing t he CONTINU E option.   It is use d in con-
  11711   "^DD",200, 200,202.2, 21,3,0)
  11712   junction w ith the LA ST OPTION  ACCESSED t o resume w hen a user  logs back
  11713   "^DD",200, 200,202.2, 21,4,0)
  11714   on.
  11715   "^DD",200, 200,203,0)
  11716   SECONDARY  MENU OPTIO NS^200.03I P^^203;0
  11717   "^DD",200, 200,203,21 ,0)
  11718   ^^1^1^2930 415^^^
  11719   "^DD",200, 200,203,21 ,1,0)
  11720   Options aw arded a us er not on  his or her  primary m enu option
  11721   "^DD",200, 200,203.1, 0)
  11722   TIMESTAMP^ FI^^203.1; 1^K:$L(X)> 15!($L(X)< 1) X
  11723   "^DD",200, 200,203.1, 3)
  11724   ANSWER MUS T BE 1-15  CHARACTERS  IN LENGTH
  11725   "^DD",200, 200,203.1, 9)
  11726   ^
  11727   "^DD",200, 200,203.1, 21,0)
  11728   ^^4^4^2851 011^^
  11729   "^DD",200, 200,203.1, 21,1,0)
  11730   This is th e time at  which this  option wa s last mod ified.  It  is trigge red
  11731   "^DD",200, 200,203.1, 21,2,0)
  11732   automatica lly by the  appropria te fields.   If a CPU  reference s an optio n
  11733   "^DD",200, 200,203.1, 21,3,0)
  11734   which has  been modif ied since  it was las t rebuilt,  it trigge rs a rebui lding
  11735   "^DD",200, 200,203.1, 21,4,0)
  11736   of the opt ions.
  11737   "^DD",200, 200,205.1, 0)
  11738   SECID^F^^2 05;1^K:$L( X)>40!($L( X)<3) X
  11739   "^DD",200, 200,205.1, .1)
  11740   SecID
  11741   "^DD",200, 200,205.1, 1,0)
  11742   ^.1
  11743   "^DD",200, 200,205.1, 1,1,0)
  11744   200^ASECID
  11745   "^DD",200, 200,205.1, 1,1,1)
  11746   S ^VA(200, "ASECID",$ E(X,1,30), DA)=""
  11747   "^DD",200, 200,205.1, 1,1,2)
  11748   K ^VA(200, "ASECID",$ E(X,1,30), DA)
  11749   "^DD",200, 200,205.1, 1,1,"%D",0 )
  11750   ^^2^2^3150 330^
  11751   "^DD",200, 200,205.1, 1,1,"%D",1 ,0)
  11752   Index of e ntries by  SecID. Wil l be used  to identif y a user f or Single 
  11753   "^DD",200, 200,205.1, 1,1,"%D",2 ,0)
  11754   Sign-On In ternal (SS Oi) and Si ngle Sign- On Externa l (SSOe).
  11755   "^DD",200, 200,205.1, 1,1,"DT")
  11756   3150209
  11757   "^DD",200, 200,205.1, 3)
  11758   Answer mus t be 3-40  characters  in length . This fie ld should  never be e dited dire ctly.
  11759   "^DD",200, 200,205.1, 9)
  11760   ^
  11761   "^DD",200, 200,205.1, 21,0)
  11762   ^.001^5^5^ 3150304^^^
  11763   "^DD",200, 200,205.1, 21,1,0)
  11764   Identity a nd Access  Management  SECID fie ld used to  uniquely  identify a  
  11765   "^DD",200, 200,205.1, 21,2,0)
  11766   VistA user  by Securi ty ID.
  11767   "^DD",200, 200,205.1, 21,3,0)
  11768    
  11769   "^DD",200, 200,205.1, 21,4,0)
  11770   *** This f ield shoul d never be  edited di rectly - d o not remo ve WRITE 
  11771   "^DD",200, 200,205.1, 21,5,0)
  11772   ACCESS!
  11773   "^DD",200, 200,205.1, "DT")
  11774   3150304
  11775   "^DD",200, 200,205.2, 0)
  11776   SUBJECT OR GANIZATION ^F^^205;2^ K:$L(X)>50 !($L(X)<3)  X
  11777   "^DD",200, 200,205.2, .1)
  11778   Subject Or ganization
  11779   "^DD",200, 200,205.2, 3)
  11780   Answer mus t be 3-50  characters  in length . This fie ld should  never be e dited dire ctly.
  11781   "^DD",200, 200,205.2, 9)
  11782   ^
  11783   "^DD",200, 200,205.2, 21,0)
  11784   ^^6^6^3150 209^
  11785   "^DD",200, 200,205.2, 21,1,0)
  11786   Identity a nd Access  Management  SUBJECT O RGANIZATIO N field us ed to 
  11787   "^DD",200, 200,205.2, 21,2,0)
  11788   identify t he Organiz ation of a n external ly authent icated use r (Subject ). 
  11789   "^DD",200, 200,205.2, 21,3,0)
  11790   Examples:  "Departmen t of Veter ans Affair s" or "Dep artment of  Defense"
  11791   "^DD",200, 200,205.2, 21,4,0)
  11792    
  11793   "^DD",200, 200,205.2, 21,5,0)
  11794   *** This f ield shoul d never be  edited di rectly - d o not remo ve WRITE 
  11795   "^DD",200, 200,205.2, 21,6,0)
  11796   ACCESS!
  11797   "^DD",200, 200,205.2, "DT")
  11798   3150209
  11799   "^DD",200, 200,205.3, 0)
  11800   SUBJECT OR GANIZATION  ID^F^^205 ;3^K:$L(X) >50!($L(X) <1) X
  11801   "^DD",200, 200,205.3, .1)
  11802   Subject Or ganization  ID
  11803   "^DD",200, 200,205.3, 3)
  11804   Answer mus t be 1-50  characters  in length . This fie ld should  never be e dited dire ctly.
  11805   "^DD",200, 200,205.3, 9)
  11806   ^
  11807   "^DD",200, 200,205.3, 21,0)
  11808   ^^12^12^31 50209^
  11809   "^DD",200, 200,205.3, 21,1,0)
  11810   Identity a nd Access  Management  SUBJECT O RGANIZATIO N ID field  used to 
  11811   "^DD",200, 200,205.3, 21,2,0)
  11812   uniquely i dentify th e Organiza tion that  is providi ng the ide ntificatio
  11813   "^DD",200, 200,205.3, 21,3,0)
  11814   for an ext ernally au thenticate d user (Su bject). Th e organiza tion ID 
  11815   "^DD",200, 200,205.3, 21,4,0)
  11816   may be an  Object Ide ntifier (O ID), using  the urn f ormat (tha t is, 
  11817   "^DD",200, 200,205.3, 21,5,0)
  11818   "urn:oid:"  appended  with the O ID); or it  may be a  URL assign ed to 
  11819   "^DD",200, 200,205.3, 21,6,0)
  11820   that organ ization. F or SSOi th is will be  hard-code d to Depar tment of 
  11821   "^DD",200, 200,205.3, 21,7,0)
  11822   Veterans A ffairs off icial Home  Community  ID. NHIN  standards  specify th at
  11823   "^DD",200, 200,205.3, 21,8,0)
  11824   the web ad dress of t he Subject  Organizat ion is typ ically sto red in thi s
  11825   "^DD",200, 200,205.3, 21,9,0)
  11826   field (exa mple: http ://familym edicalclin ic.org).
  11827   "^DD",200, 200,205.3, 21,10,0)
  11828    
  11829   "^DD",200, 200,205.3, 21,11,0)
  11830   *** This f ield shoul d never be  edited di rectly - d o not remo ve WRITE 
  11831   "^DD",200, 200,205.3, 21,12,0)
  11832   ACCESS!
  11833   "^DD",200, 200,205.3, "DT")
  11834   3150209
  11835   "^DD",200, 200,205.4, 0)
  11836   UNIQUE USE R ID^F^^20 5;4^K:$L(X )>40!($L(X )<3) X
  11837   "^DD",200, 200,205.4, .1)
  11838   Unique Use r ID
  11839   "^DD",200, 200,205.4, 3)
  11840   Answer mus t be 3-40  characters  in length . This fie ld should  never be e dited dire ctly.
  11841   "^DD",200, 200,205.4, 9)
  11842   ^
  11843   "^DD",200, 200,205.4, 21,0)
  11844   ^.001^9^9^ 3150304^^
  11845   "^DD",200, 200,205.4, 21,1,0)
  11846   Identity a nd Access  Management  UNIQUE US ER ID fiel d used to  uniquely 
  11847   "^DD",200, 200,205.4, 21,2,0)
  11848   identify a  user (Sub ject) with in the Sub ject Organ ization. T he combina tion
  11849   "^DD",200, 200,205.4, 21,3,0)
  11850   of Subject  Organizat ion ID (OI D) and Uni que User I D (UID) is
  11851   "^DD",200, 200,205.4, 21,4,0)
  11852   cross-refe renced in  VistA and  must be un ique. For  VA SSOi, t his will b
  11853   "^DD",200, 200,205.4, 21,5,0)
  11854   the user S ecID. With in NHIN th is could b e the subj ect of the  NHIN SAML  
  11855   "^DD",200, 200,205.4, 21,6,0)
  11856   token whic h would co ntain emai l address  of a X.509  name.
  11857   "^DD",200, 200,205.4, 21,7,0)
  11858    
  11859   "^DD",200, 200,205.4, 21,8,0)
  11860   *** This f ield shoul d never be  edited di rectly - d o not remo ve WRITE 
  11861   "^DD",200, 200,205.4, 21,9,0)
  11862   ACCESS!
  11863   "^DD",200, 200,205.4, "DT")
  11864   3150304
  11865   "^DD",200, 200,205.5, 0)
  11866   ADUPN^F^^2 05;5^K:$L( X)>50!($L( X)<3) X
  11867   "^DD",200, 200,205.5, .1)
  11868   Active Dir ectory UPN
  11869   "^DD",200, 200,205.5, 1,0)
  11870   ^.1
  11871   "^DD",200, 200,205.5, 1,1,0)
  11872   200^ADUPN
  11873   "^DD",200, 200,205.5, 1,1,1)
  11874   S ^VA(200, "ADUPN",$E (X,1,30),D A)=""
  11875   "^DD",200, 200,205.5, 1,1,2)
  11876   K ^VA(200, "ADUPN",$E (X,1,30),D A)
  11877   "^DD",200, 200,205.5, 1,1,"%D",0 )
  11878   ^^4^4^3150 330^
  11879   "^DD",200, 200,205.5, 1,1,"%D",1 ,0)
  11880   Index of e ntries by  Active Dir ectory UPN . Will be  used by Id entity and  
  11881   "^DD",200, 200,205.5, 1,1,"%D",2 ,0)
  11882   Access Man agement (I AM) Provis ioning app lication w hen search ing for an
  11883   "^DD",200, 200,205.5, 1,1,"%D",3 ,0)
  11884   provisioni ng a VistA  user to m atch the u ser with a n Active D irectory 
  11885   "^DD",200, 200,205.5, 1,1,"%D",4 ,0)
  11886   account.
  11887   "^DD",200, 200,205.5, 1,1,"DT")
  11888   3150209
  11889   "^DD",200, 200,205.5, 3)
  11890   Answer mus t be 3-50  characters  in length . This fie ld should  never be e dited dire ctly.
  11891   "^DD",200, 200,205.5, 9)
  11892   ^
  11893   "^DD",200, 200,205.5, 21,0)
  11894   ^.001^2^2^ 3150209^^
  11895   "^DD",200, 200,205.5, 21,1,0)
  11896   Identity a nd Access  Management  Active Di rectory Us er Princip le Name (A
  11897   "^DD",200, 200,205.5, 21,2,0)
  11898   UPN) field .
  11899   "^DD",200, 200,205.5, "DT")
  11900   3150209
  11901   "^DD",200, 200,351,0)
  11902   PERSONAL D IAGNOSES L IST^200.03 51PA^^351; 0
  11903   "^DD",200, 200,351,21 ,0)
  11904   ^.001^1^1^ 3040708^^^ ^
  11905   "^DD",200, 200,351,21 ,1,0)
  11906   This is th e provider 's persona l list of  preferred  diagnoses  codes.
  11907   "^DD",200, 200,400,0)
  11908   SUPPLY EMP LOYEE^S^1: WAREHOUSE; 2:PPM ACCO UNTABLE OF FICER;3:PU RCHASING A GENT;4:MAN AGER;^400; 1^Q
  11909   "^DD",200, 200,400,"D T")
  11910   2921230
  11911   "^DD",200, 200,442.1, 0)
  11912   SECURITY T RAINING LA ST^D^^4;1^ S %DT="EX"  D ^%DT S  X=Y K:Y<1  X
  11913   "^DD",200, 200,442.1, 3)
  11914   Enter Date  Security  Training w as last At tended.
  11915   "^DD",200, 200,442.1, "DT")
  11916   2920213
  11917   "^DD",200, 200,450,0)
  11918   PAID EMPLO YEE^P450'^ PRSPC(^450 ;1^Q
  11919   "^DD",200, 200,450,9)
  11920   ^
  11921   "^DD",200, 200,450,21 ,0)
  11922   ^^1^1^2950 426^^
  11923   "^DD",200, 200,450,21 ,1,0)
  11924   This field  is a poin ter to the  PAID EMPL OYEE (#450 ) file.
  11925   "^DD",200, 200,450,"D T")
  11926   2950426
  11927   "^DD",200, 200,500,0)
  11928   NETWORK AD DRESS^200. 005A^^500; 0
  11929   "^DD",200, 200,500,21 ,0)
  11930   ^^2^2^2910 621^^
  11931   "^DD",200, 200,500,21 ,1,0)
  11932   This is th e begining  of a netw ork addres s.  Enter  the Lastna me of the  user
  11933   "^DD",200, 200,500,21 ,2,0)
  11934   or an iden tifier tha t he is kn own as on  the receiv ing system .
  11935   "^DD",200, 200,501.1, 0)
  11936   NETWORK US ERNAME^FX^ ^501;1^K:$ L(X)>15 X  I $D(X) S  X=$$UP^XLF STR(X) K:$ $NETNM^XUS ER1(X,DA)  X
  11937   "^DD",200, 200,501.1, .1)
  11938   Network Us ername
  11939   "^DD",200, 200,501.1, 3)
  11940   Enter the  Active Dir ectory Use rname (9-1 5 characte rs).
  11941   "^DD",200, 200,501.1, 21,0)
  11942   ^.001^4^4^ 3150317^^
  11943   "^DD",200, 200,501.1, 21,1,0)
  11944   This is th e username  that is u sed by the  Windows A ctive Dire ctory.
  11945   "^DD",200, 200,501.1, 21,2,0)
  11946   It should  be 'VHA' +  3 char st ation ID +  first 5 o f last nam e + first
  11947   "^DD",200, 200,501.1, 21,3,0)
  11948   character  of first n ame.
  11949   "^DD",200, 200,501.1, 21,4,0)
  11950   Holders of  the XUMGR  key can o verride th is.
  11951   "^DD",200, 200,501.1, 23,0)
  11952   ^.001^2^2^ 3150317^^
  11953   "^DD",200, 200,501.1, 23,1,0)
  11954   Holders of  the XUMGR  key can o verride th e syntax c heck.
  11955   "^DD",200, 200,501.1, 23,2,0)
  11956   Users with  DUZ(0)="@ " can over ride the s yntax chec k.
  11957   "^DD",200, 200,501.1, "DT")
  11958   3150317
  11959   "^DD",200, 200,501.2, 0)
  11960   SUBJECT AL TERNATIVE  NAME^FaX^^ 501;2^K:$L (X)>50!($L (X)<3)!'(X ["@") X I  $D(X) N XU SSAN S XUS SAN=$O(^VA (200,"ASAN ",X,"")) K :(XUSSAN>0 )&(XUSSAN' =DA) X
  11961   "^DD",200, 200,501.2, 1,0)
  11962   ^.1
  11963   "^DD",200, 200,501.2, 1,1,0)
  11964   ^^BULLETIN  MESSAGE
  11965   "^DD",200, 200,501.2, 1,1,1)
  11966   Q
  11967   "^DD",200, 200,501.2, 1,1,2)
  11968   S Y(0)=X,D 0=DA X "N  DIIND F DI IND=2.001: .001 Q:$D( ^DD(200,50 1.2,1,1,DI IND))[0  X  ^(DIIND)"  K XMY S X MB="XUSSPK I SAN" D B ULL^XUSER  D ^XMB:$D( ^XMB(3.6," B",XMB)) K  Y,XMB
  11969   "^DD",200, 200,501.2, 1,1,2.001)
  11970   S X=Y(0) S  X=X S XMB (1)=X
  11971   "^DD",200, 200,501.2, 1,1,2.002)
  11972   S X=Y(0) S  Y(1)=$S($ D(^VA(200, D0,501)):^ (501),1:"" ) S X=$P(Y (1),U,2) S  XMB(2)=X
  11973   "^DD",200, 200,501.2, 1,1,2.003)
  11974   S X=Y(0) S  Y(1)=$S($ D(^VA(200, D0,0)):^(0 ),1:"") S  X=$P(Y(1), U,1) S XMB (3)=X
  11975   "^DD",200, 200,501.2, 1,1,3)
  11976   This cross -reference  must not  be deleted  because i t has spec ial code i n DD.
  11977   "^DD",200, 200,501.2, 1,1,"%D",0 )
  11978   ^^4^4^3120 822^
  11979   "^DD",200, 200,501.2, 1,1,"%D",1 ,0)
  11980   When the S ubject Alt ernative N ame field  in file #2 00 is eith er modifie d or
  11981   "^DD",200, 200,501.2, 1,1,"%D",2 ,0)
  11982   deleted, t his bullet in will be  fired off .  Users h olding the  PSDMGR ke y
  11983   "^DD",200, 200,501.2, 1,1,"%D",3 ,0)
  11984   will recei ve this bu lletin.  T his cross  reference  must not b e deleted
  11985   "^DD",200, 200,501.2, 1,1,"%D",4 ,0)
  11986   because it  contains  special co de in the  DD that ca lls BULL^X USER.
  11987   "^DD",200, 200,501.2, 1,1,"CREAT E VALUE")
  11988   NO EFFECT
  11989   "^DD",200, 200,501.2, 1,1,"DELET E PARAMETE R #1")
  11990   OLD SUBJEC T ALTERNAT IVE NAME
  11991   "^DD",200, 200,501.2, 1,1,"DELET E PARAMETE R #2")
  11992   SUBJECT AL TERNATIVE  NAME
  11993   "^DD",200, 200,501.2, 1,1,"DELET E PARAMETE R #3")
  11994   NAME
  11995   "^DD",200, 200,501.2, 1,1,"DELET E VALUE")
  11996   XUSSPKI SA N
  11997   "^DD",200, 200,501.2, 1,2,0)
  11998   200^ASAN
  11999   "^DD",200, 200,501.2, 1,2,1)
  12000   S ^VA(200, "ASAN",$E( X,1,30),DA )=""
  12001   "^DD",200, 200,501.2, 1,2,2)
  12002   K ^VA(200, "ASAN",$E( X,1,30),DA )
  12003   "^DD",200, 200,501.2, 1,2,3)
  12004   This cross -reference  is used t o insure t hat all Su bject Alte rnative Na me entries  are uniqu e and is r equired by  the DEA e lectronic- Prescribin g of Contr olled Subs tances rul es.
  12005   "^DD",200, 200,501.2, 1,2,"%D",0 )
  12006   ^.101^2^2^ 3130321^^^
  12007   "^DD",200, 200,501.2, 1,2,"%D",1 ,0)
  12008   This is a  cross-refe rence used  to insure  that the  Subject Al ternative  Name entri es are uni que as req uired by D EA rules f or electro nic-Prescr ibing of C ontrolled  Substances .  
  12009   "^DD",200, 200,501.2, 1,2,"%D",2 ,0)
  12010  
  12011   "^DD",200, 200,501.2, 1,2,"DT")
  12012   3130321
  12013   "^DD",200, 200,501.2, 3)
  12014   Answer mus t be 3-50  characters  in length  and conta in an '@'  character  and be uni que in the  file
  12015   "^DD",200, 200,501.2, 21,0)
  12016   ^.001^12^1 2^3130321^ ^^^
  12017   "^DD",200, 200,501.2, 21,1,0)
  12018   This is a  name from  the PIV ca rd field S UBJECT ALT ERNATIVE N AME
  12019   "^DD",200, 200,501.2, 21,2,0)
  12020   also known  as USER P RINCIPLE N AME. 
  12021   "^DD",200, 200,501.2, 21,3,0)
  12022    
  12023   "^DD",200, 200,501.2, 21,4,0)
  12024   The subjec t alternat ive name e xtension a llows iden tities to  be bound
  12025   "^DD",200, 200,501.2, 21,5,0)
  12026   to the sub ject of th e certific ate.  Thes e identiti es may be  included
  12027   "^DD",200, 200,501.2, 21,6,0)
  12028   in additio n to or in  place of  the identi ty in the  subject fi eld of
  12029   "^DD",200, 200,501.2, 21,7,0)
  12030   the certif icate.  Su bject alte rnative na me is defi ned by an  Internet 
  12031   "^DD",200, 200,501.2, 21,8,0)
  12032   electronic  mail addr ess.
  12033   "^DD",200, 200,501.2, 21,9,0)
  12034    
  12035   "^DD",200, 200,501.2, 21,10,0)
  12036   When the s ubjectAltN ame extens ion contai ns an Inte rnet mail  address,
  12037   "^DD",200, 200,501.2, 21,11,0)
  12038   the addres s MUST be  stored in  the rfc822 Name.
  12039   "^DD",200, 200,501.2, 21,12,0)
  12040  
  12041   "^DD",200, 200,501.2, 23,0)
  12042   ^.001^3^3^ 3130321^^^ ^
  12043   "^DD",200, 200,501.2, 23,1,0)
  12044   This field  has a bul letin type  xref that  must not  be deleted  because 
  12045   "^DD",200, 200,501.2, 23,2,0)
  12046   it contain s special  code in th e DD.  The  code will  call BULL ^XUSER the
  12047   "^DD",200, 200,501.2, 23,3,0)
  12048   fire off b ulletins t o users ho lding the  PSDMGR key .
  12049   "^DD",200, 200,501.2, "AUDIT")
  12050   y
  12051   "^DD",200, 200,501.2, "DT")
  12052   3130321
  12053   "^DD",200, 200,654,0)
  12054   SOCIAL WOR KER ?^SX^1 :YES;0:NO; ^654;1^K:' $D(SOWKNEW ) X
  12055   "^DD",200, 200,654,1, 0)
  12056   ^.1
  12057   "^DD",200, 200,654,1, 1,0)
  12058   200^ASWB^M UMPS
  12059   "^DD",200, 200,654,1, 1,1)
  12060   S ^VA(200, "ASWB",DA, DA)=""
  12061   "^DD",200, 200,654,1, 1,2)
  12062   K ^VA(200, "ASWB",DA, DA)
  12063   "^DD",200, 200,654,1, 1,"%D",0)
  12064   ^^1^1^2911 125^
  12065   "^DD",200, 200,654,1, 1,"%D",1,0 )
  12066   This cross  reference  is used f or screeni ng out non -social wo rkers.
  12067   "^DD",200, 200,654,3)
  12068   Enter '1'  for YES to  indicate  if user is  a Social  Worker.
  12069   "^DD",200, 200,654,21 ,0)
  12070   ^^2^2^2930 618^^^^
  12071   "^DD",200, 200,654,21 ,1,0)
  12072   This field  will be u sed to ind icate if t he user is  a Social  Worker.
  12073   "^DD",200, 200,654,21 ,2,0)
  12074   It will al so act as  a screen f or lookups .
  12075   "^DD",200, 200,654,"D T")
  12076   2911108
  12077   "^DD",200, 200,654.1, 0)
  12078   IMMEDIATE  SUPERVISOR ^*P200'X^V A(200,^654 ;2^S DIC(" S")="I $D( ^VA(200,"" ASWE"",+Y) )" D ^DIC  K DIC S DI C=DIE,X=+Y  K:Y<0!'$D (SOWKNEW)  X
  12079   "^DD",200, 200,654.1, 1,0)
  12080   ^.1
  12081   "^DD",200, 200,654.1, 1,1,0)
  12082   200^ASWC
  12083   "^DD",200, 200,654.1, 1,1,1)
  12084   S ^VA(200, "ASWC",$E( X,1,30),DA )=""
  12085   "^DD",200, 200,654.1, 1,1,2)
  12086   K ^VA(200, "ASWC",$E( X,1,30),DA )
  12087   "^DD",200, 200,654.1, 3)
  12088   Enter the  name of th e immediat e supervis or of the  social wor ker.
  12089   "^DD",200, 200,654.1, 4)
  12090  
  12091   "^DD",200, 200,654.1, 12)
  12092   Only Valid  social wo rk managem ent are to  be select ed.
  12093   "^DD",200, 200,654.1, 12.1)
  12094   S DIC("S") ="I $D(^VA (200,""ASW E"",+Y))"
  12095   "^DD",200, 200,654.1, 21,0)
  12096   ^^1^1^2930 618^^^^
  12097   "^DD",200, 200,654.1, 21,1,0)
  12098   This field  is used t o indicate  the immed iate super visor of t he social  worker.
  12099   "^DD",200, 200,654.1, "DT")
  12100   2930222
  12101   "^DD",200, 200,654.15 ,0)
  12102   POSITION/T ITLE^SX^1: SW CHIEF;2 :ASST. CHI EF;3:SUPER VISOR;4:SW  COORDINAT OR;5:SOCIA L WORKER;6 :SW ASSOCI ATE;7:SECR ETARY;8:SW  CLERK/STE NO;9:STUDE NT;10:VOLU NTEER;11:W OC;^654;5^ K:'$D(SOWK NEW) X
  12103   "^DD",200, 200,654.15 ,1,0)
  12104   ^.1
  12105   "^DD",200, 200,654.15 ,1,1,0)
  12106   200^ASWE^M UMPS
  12107   "^DD",200, 200,654.15 ,1,1,1)
  12108   S:X=1!(X=2 )!(X=3) ^V A(200,"ASW E",DA,$E(X ,1,30))=""
  12109   "^DD",200, 200,654.15 ,1,1,2)
  12110   K:X=1!(X=2 )!(X=3) ^V A(200,"ASW E",DA,$E(X ,1,30))
  12111   "^DD",200, 200,654.15 ,1,1,"%D", 0)
  12112   ^^1^1^2911 125^
  12113   "^DD",200, 200,654.15 ,1,1,"%D", 1,0)
  12114   This cross  reference  is used f or chiefs,  asst. chi efs, and s upervisors  only.
  12115   "^DD",200, 200,654.15 ,3)
  12116   Enter the  title of t he social  worker.
  12117   "^DD",200, 200,654.15 ,21,0)
  12118   ^^1^1^2930 618^^^^
  12119   "^DD",200, 200,654.15 ,21,1,0)
  12120   This field  will be u sed to ind icate the  position/t itle of th e social w orker.
  12121   "^DD",200, 200,654.15 ,"DT")
  12122   2911108
  12123   "^DD",200, 200,654.2, 0)
  12124   SOCIAL WOR KER'S NUMB ER^NJ3,0X^ ^654;3^K:$ L(X)>3!($L (X)<2)!'(X ?2N.N)!('$ D(SOWKNEW) ) X I $D(X ),$D(^VA(2 00,"ASWD", X)) W *7,"  NUMBER AL READY ASSI GNED !!",!  K X
  12125   "^DD",200, 200,654.2, 1,0)
  12126   ^.1
  12127   "^DD",200, 200,654.2, 1,1,0)
  12128   200^ASWD
  12129   "^DD",200, 200,654.2, 1,1,1)
  12130   S ^VA(200, "ASWD",$E( X,1,30),DA )=""
  12131   "^DD",200, 200,654.2, 1,1,2)
  12132   K ^VA(200, "ASWD",$E( X,1,30),DA )
  12133   "^DD",200, 200,654.2, 3)
  12134   Enter numb er 01-999.
  12135   "^DD",200, 200,654.2, 21,0)
  12136   ^^1^1^2930 618^^^
  12137   "^DD",200, 200,654.2, 21,1,0)
  12138   Unique num ber assign ed to soci al worker  by service .  Enter a  number 01 -999.
  12139   "^DD",200, 200,654.2, "DT")
  12140   2911113
  12141   "^DD",200, 200,654.3, 0)
  12142   SURROGATE^ P200'X^VA( 200,^654;4 ^K:'$D(SOW KNEW) X
  12143   "^DD",200, 200,654.3, 1,0)
  12144   ^.1
  12145   "^DD",200, 200,654.3, 1,1,0)
  12146   200^ACSW
  12147   "^DD",200, 200,654.3, 1,1,1)
  12148   S ^VA(200, "ACSW",$E( X,1,30),DA )=""
  12149   "^DD",200, 200,654.3, 1,1,2)
  12150   K ^VA(200, "ACSW",$E( X,1,30),DA )
  12151   "^DD",200, 200,654.3, 3)
  12152   Enter supe rvisor's n ame that i s to be th e surrogat e.
  12153   "^DD",200, 200,654.3, 21,0)
  12154   ^^3^3^2930 618^^^^
  12155   "^DD",200, 200,654.3, 21,1,0)
  12156   This field  will be u sed to ind icate a su rrogate su pervisor.   When this
  12157   "^DD",200, 200,654.3, 21,2,0)
  12158   field has  data, the  surrogate  supervisor  will have  access to  data pert aining
  12159   "^DD",200, 200,654.3, 21,3,0)
  12160   to worker  informatio n for the  surrogated  superviso r.
  12161   "^DD",200, 200,654.3, "DT")
  12162   2911108
  12163   "^DD",200, 200,720,0)
  12164   DMMS UNITS ^200.72P^^ EC;0
  12165   "^DD",200, 200,720,21 ,0)
  12166   ^^2^2^2930 408^^
  12167   "^DD",200, 200,720,21 ,1,0)
  12168   This multi ple field  contains t he DMMS un its to whi ch this pe rson has
  12169   "^DD",200, 200,720,21 ,2,0)
  12170   access for  entering  data and g enerating  reports.
  12171   "^DD",200, 200,720,23 ,0)
  12172   ^^1^1^2930 408^
  12173   "^DD",200, 200,720,23 ,1,0)
  12174   Multiple p ointer to  724
  12175   "^DD",200, 200,747.11 ,0)
  12176   APPOINTMEN T STATUS^S ^1:FULL-TI ME;2:PART- TIME;3:CON SULTING;4: CONTRACT;5 :RESIDENT; 6:FEE BASI S, ON STAT ION;7:SPEC IALTY FELL OW;8:WOC;9 :OTHER;^QA R12;1^Q
  12177   "^DD",200, 200,747.11 ,3)
  12178   Enter the  appropriat e Appointm ent Status .
  12179   "^DD",200, 200,747.11 ,21,0)
  12180   ^^1^1^2910 403^^
  12181   "^DD",200, 200,747.11 ,21,1,0)
  12182   Contains t he Appoint ment Statu s for this  person.
  12183   "^DD",200, 200,747.11 ,"DT")
  12184   2900817
  12185   "^DD",200, 200,747.11 3,0)
  12186   RENEW DATE ^D^^QAR8;2 ^S %DT="E"  D ^%DT S  X=Y K:Y<1  X
  12187   "^DD",200, 200,747.11 3,3)
  12188   Enter the  Renewal Da te for our  General P rivilege.
  12189   "^DD",200, 200,747.11 3,21,0)
  12190   ^^1^1^2910 403^
  12191   "^DD",200, 200,747.11 3,21,1,0)
  12192   Contains t he Renewal  Date for  our Genera l Privileg e.
  12193   "^DD",200, 200,747.11 3,"DT")
  12194   2900821
  12195   "^DD",200, 200,747.44 ,0)
  12196   DEA EXPIRA TION DATE^ D^^QAR;9^S  %DT="EX"  D ^%DT S X =Y K:Y<1 X
  12197   "^DD",200, 200,747.44 ,3)
  12198   Enter DEA  # Expirati on Date
  12199   "^DD",200, 200,747.44 ,21,0)
  12200   ^.001^1^1^ 3121025^^
  12201   "^DD",200, 200,747.44 ,21,1,0)
  12202   This field  contains  the expira tion date  for DEA #.
  12203   "^DD",200, 200,747.44 ,"DT")
  12204   2910723
  12205   "^DD",200, 200,900,0)
  12206   Enumeratio n Initiate d^D^^MPI;1 ^S %DT="ET X" D ^%DT  S X=Y K:X< 1 X
  12207   "^DD",200, 200,900,3)
  12208   (No range  limit on d ate)
  12209   "^DD",200, 200,900,21 ,0)
  12210   ^^2^2^3100 903^
  12211   "^DD",200, 200,900,21 ,1,0)
  12212   This field  notes the  date/time  the VPID  enumeratio n attempt  was 
  12213   "^DD",200, 200,900,21 ,2,0)
  12214   initiated.
  12215   "^DD",200, 200,900,"D T")
  12216   3100903
  12217   "^DD",200, 200,901,0)
  12218   Enumeratio n Complete d^D^^MPI;2 ^S %DT="ET X" D ^%DT  S X=Y K:X< 1 X
  12219   "^DD",200, 200,901,3)
  12220   (No range  limit on d ate)
  12221   "^DD",200, 200,901,21 ,0)
  12222   ^^1^1^3100 903^
  12223   "^DD",200, 200,901,21 ,1,0)
  12224   This field  notes the  date/time  the VPID  assignment  was compl eted.
  12225   "^DD",200, 200,901,"D T")
  12226   3100903
  12227   "^DD",200, 200,902,0)
  12228   Requires T ransmissio n^S^Y:Yes; ^MPI;3^Q
  12229   "^DD",200, 200,902,1, 0)
  12230   ^.1
  12231   "^DD",200, 200,902,1, 1,0)
  12232   200^AXMIT^ MUMPS
  12233   "^DD",200, 200,902,1, 1,1)
  12234   I X="Y",$P ($G(^XTV(8 989.3,1,"M PI")),"^", 3)'="" S ^ VA(200,"AX MIT",DA)=" "
  12235   "^DD",200, 200,902,1, 1,2)
  12236   I X="" K ^ VA(200,"AX MIT",DA)
  12237   "^DD",200, 200,902,1, 1,"%D",0)
  12238   ^.101^3^3^ 3100907^^
  12239   "^DD",200, 200,902,1, 1,"%D",1,0 )
  12240   This cross  reference  will be s et to note  that this  record wa s just add ed
  12241   "^DD",200, 200,902,1, 1,"%D",2,0 )
  12242   to this fi le and nee ds a VPID  or that th is record  had a fiel d that MPI  is
  12243   "^DD",200, 200,902,1, 1,"%D",3,0 )
  12244   monitoring  edited an d needs to  be sent t o the MPI.
  12245   "^DD",200, 200,902,1, 1,"DT")
  12246   3100907
  12247   "^DD",200, 200,902,21 ,0)
  12248   ^^21^21^31 00907^
  12249   "^DD",200, 200,902,21 ,1,0)
  12250   This field  is used t o note tha t this rec ord was ju st added t o this fil e, 
  12251   "^DD",200, 200,902,21 ,2,0)
  12252   or that an  edit was  made to th e fields t hat MPI ca res about  capturing  and 
  12253   "^DD",200, 200,902,21 ,3,0)
  12254   a VPID nee ds to be a ssigned or  an update  message n eeds to be  sent.
  12255   "^DD",200, 200,902,21 ,4,0)
  12256    
  12257   "^DD",200, 200,902,21 ,5,0)
  12258   Fields bei ng monitor ed for cha nge are:
  12259   "^DD",200, 200,902,21 ,6,0)
  12260    
  12261   "^DD",200, 200,902,21 ,7,0)
  12262    .01            NAME 
  12263   "^DD",200, 200,902,21 ,8,0)
  12264    .111           STREE T ADDRESS 
  12265   "^DD",200, 200,902,21 ,9,0)
  12266    .112           STREE T ADDRESS 
  12267   "^DD",200, 200,902,21 ,10,0)
  12268    .113           STREE T ADDRESS 
  12269   "^DD",200, 200,902,21 ,11,0)
  12270    .114           CITY 
  12271   "^DD",200, 200,902,21 ,12,0)
  12272    .115           STATE  
  12273   "^DD",200, 200,902,21 ,13,0)
  12274    .116           ZIP C ODE 
  12275   "^DD",200, 200,902,21 ,14,0)
  12276    .131           PHONE  (HOME) 
  12277   "^DD",200, 200,902,21 ,15,0)
  12278    4              SEX 
  12279   "^DD",200, 200,902,21 ,16,0)
  12280    5              DOB 
  12281   "^DD",200, 200,902,21 ,17,0)
  12282    9              SSN 
  12283   "^DD",200, 200,902,21 ,18,0)
  12284    41.99          NPI 
  12285   "^DD",200, 200,902,21 ,19,0)
  12286    53.2           DEA# 
  12287   "^DD",200, 200,902,21 ,20,0)
  12288    200.06,.0 1    VISIT ED FROM 
  12289   "^DD",200, 200,902,21 ,21,0)
  12290    200.06,2       DUZ A T HOME SIT E
  12291   "^DD",200, 200,902,"D T")
  12292   3100907
  12293   "^DD",200, 200,910.1, 0)
  12294   BADGE NUMB ER^NJ6,0^^ ESP;1^K:+X '=X!(X>999 999)!(X<1) !(X?.E1"." 1N.N) X
  12295   "^DD",200, 200,910.1, 3)
  12296   Enter the  police off icer's ass igned badg e number [ 1-999999].
  12297   "^DD",200, 200,910.1, 21,0)
  12298   ^^1^1^2931 001^^
  12299   "^DD",200, 200,910.1, 21,1,0)
  12300   Enter the  badge numb er assigne d to the V A police o fficer.
  12301   "^DD",200, 200,910.1, "DT")
  12302   2930715
  12303   "^DD",200, 200,910.2, 0)
  12304   RANK^F^^ES P;2^K:$L(X )>30!($L(X )<2) X
  12305   "^DD",200, 200,910.2, 3)
  12306   Enter the  police off icer's ass igned rank  [2-30 cha racters].
  12307   "^DD",200, 200,910.2, 21,0)
  12308   ^^2^2^2930 913^
  12309   "^DD",200, 200,910.2, 21,1,0)
  12310   Enter the  VA police  officer's  assigned r ank design ation, i.e ., CHIEF,
  12311   "^DD",200, 200,910.2, 21,2,0)
  12312   LIEUTENANT , PATROL O FFICER, et c.
  12313   "^DD",200, 200,910.2, "DT")
  12314   2930715
  12315   "^DD",200, 200,8910,0 )
  12316   VISITED FR OM^200.06A ^^8910;0
  12317   "^DD",200, 200,8910,2 1,0)
  12318   ^^8^8^3000 208^
  12319   "^DD",200, 200,8910,2 1,1,0)
  12320   This subfi le stores  the inform ation that  travels a long with  visitors u sing
  12321   "^DD",200, 200,8910,2 1,2,0)
  12322   the CPRS F oreign Vie ws softwar e to look  at medical  data of a  patient w hich
  12323   "^DD",200, 200,8910,2 1,3,0)
  12324   resides on  a system  where the  visitor ma y not have  valid acc ess or ver ify
  12325   "^DD",200, 200,8910,2 1,4,0)
  12326   codes.  Wh en that pe rson name  and Social  Security  Number is  put into t he
  12327   "^DD",200, 200,8910,2 1,5,0)
  12328   visited sy stem's New  Person Fi le this mu ltiple is  updated to  provide t he
  12329   "^DD",200, 200,8910,2 1,6,0)
  12330   ability to  trace the  visitors  back to th e system f rom which  they are
  12331   "^DD",200, 200,8910,2 1,7,0)
  12332   visiting.   This fiel d (.01) st ores the n umber of t he site wh ere the
  12333   "^DD",200, 200,8910,2 1,8,0)
  12334   visitor wa s authenti cated.
  12335   "^DD",200, 200,8932.0 01,0)
  12336   PROVIDER K EY^CJ1^^ ;  ^S X=($D( ^XUSEC("PR OVIDER",D0 ))[1)
  12337   "^DD",200, 200,8932.0 01,9)
  12338   ^
  12339   "^DD",200, 200,8932.0 01,9.01)
  12340  
  12341   "^DD",200, 200,8932.0 01,9.1)
  12342   S X=($D(^X USEC("PROV IDER",D0)) [1)
  12343   "^DD",200, 200,8932.0 01,21,0)
  12344   ^^3^3^2960 703^
  12345   "^DD",200, 200,8932.0 01,21,1,0)
  12346   This Compu ted field  gets a 1 i f the user  holds the  provider  key.
  12347   "^DD",200, 200,8932.0 01,21,2,0)
  12348   It is expe cted that  the field  will be re moved or c hanged aft er
  12349   "^DD",200, 200,8932.0 01,21,3,0)
  12350   the Person  class fie ld convers ion is com pleted.
  12351   "^DD",200, 200,8932.0 01,"DT")
  12352   2960614
  12353   "^DD",200, 200,8932.1 ,0)
  12354   PERSON CLA SS^200.05P ^^USC1;0
  12355   "^DD",200, 200,8932.2 ,0)
  12356   PGYear^NJ2 ,0^^USC2;1 ^K:+X'=X!( X>10)!(X<1 )!(X?.E1". "1N.N) X
  12357   "^DD",200, 200,8932.2 ,1,0)
  12358   ^.1
  12359   "^DD",200, 200,8932.2 ,1,1,0)
  12360   ^^TRIGGER^ 200^8932.2 1
  12361   "^DD",200, 200,8932.2 ,1,1,1)
  12362   K DIV S DI V=X,D0=DA, DIV(0)=D0  S Y(1)=$S( $D(^VA(200 ,D0,"USC2" )):^("USC2 "),1:"") S  X=$P(Y(1) ,U,2),X=X  S DIU=X K  Y S X=DIV  N %I,%H,%  D NOW^%DTC  X ^DD(200 ,8932.2,1, 1,1.4)
  12363   "^DD",200, 200,8932.2 ,1,1,1.4)
  12364   S DIH=$S($ D(^VA(200, DIV(0),"US C2")):^("U SC2"),1:"" ),DIV=X S  $P(^("USC2 "),U,2)=DI V,DIH=200, DIG=8932.2 1 D ^DICR: $O(^DD(DIH ,DIG,1,0)) >0
  12365   "^DD",200, 200,8932.2 ,1,1,2)
  12366   K DIV S DI V=X,D0=DA, DIV(0)=D0  S Y(1)=$S( $D(^VA(200 ,D0,"USC2" )):^("USC2 "),1:"") S  X=$P(Y(1) ,U,2),X=X  S DIU=X K  Y S X="" X  ^DD(200,8 932.2,1,1, 2.4)
  12367   "^DD",200, 200,8932.2 ,1,1,2.4)
  12368   S DIH=$S($ D(^VA(200, DIV(0),"US C2")):^("U SC2"),1:"" ),DIV=X S  $P(^("USC2 "),U,2)=DI V,DIH=200, DIG=8932.2 1 D ^DICR: $O(^DD(DIH ,DIG,1,0)) >0
  12369   "^DD",200, 200,8932.2 ,1,1,"CREA TE VALUE")
  12370   TODAY
  12371   "^DD",200, 200,8932.2 ,1,1,"DELE TE VALUE")
  12372   @
  12373   "^DD",200, 200,8932.2 ,1,1,"FIEL D")
  12374   PGY as
  12375   "^DD",200, 200,8932.2 ,3)
  12376   Type a Num ber betwee n 1 and 10 , 0 Decima l Digits
  12377   "^DD",200, 200,8932.2 ,21,0)
  12378   ^^1^1^2960 612^
  12379   "^DD",200, 200,8932.2 ,21,1,0)
  12380   This field  holds wha t Post Gra duate year  a person  is.
  12381   "^DD",200, 200,8932.2 ,"DT")
  12382   2960614
  12383   "^DD",200, 200,8932.2 1,0)
  12384   PGY assign ed^D^^USC2 ;2^S %DT=" EX" D ^%DT  S X=Y K:Y <1 X
  12385   "^DD",200, 200,8932.2 1,5,1,0)
  12386   200^8932.2 ^1
  12387   "^DD",200, 200,8932.2 1,9)
  12388   ^
  12389   "^DD",200, 200,8932.2 1,21,0)
  12390   ^^1^1^2960 614^^
  12391   "^DD",200, 200,8932.2 1,21,1,0)
  12392   This field  holds the  date that  the PGYea r field wa s last edi ted.
  12393   "^DD",200, 200,8932.2 1,"DT")
  12394   2960614
  12395   "^DD",200, 200,8932.3 ,0)
  12396   FYear^NJ1, 0^^USC2;3^ K:+X'=X!(X >9)!(X<1)! (X?.E1"."1 N.N) X
  12397   "^DD",200, 200,8932.3 ,1,0)
  12398   ^.1
  12399   "^DD",200, 200,8932.3 ,1,1,0)
  12400   ^^TRIGGER^ 200^8932.3 1
  12401   "^DD",200, 200,8932.3 ,1,1,1)
  12402   K DIV S DI V=X,D0=DA, DIV(0)=D0  S Y(1)=$S( $D(^VA(200 ,D0,"USC2" )):^("USC2 "),1:"") S  X=$P(Y(1) ,U,4),X=X  S DIU=X K  Y S X=DIV  N %I,%H,%  D NOW^%DTC  X ^DD(200 ,8932.3,1, 1,1.4)
  12403   "^DD",200, 200,8932.3 ,1,1,1.4)
  12404   S DIH=$S($ D(^VA(200, DIV(0),"US C2")):^("U SC2"),1:"" ),DIV=X S  $P(^("USC2 "),U,4)=DI V,DIH=200, DIG=8932.3 1 D ^DICR: $O(^DD(DIH ,DIG,1,0)) >0
  12405   "^DD",200, 200,8932.3 ,1,1,2)
  12406   K DIV S DI V=X,D0=DA, DIV(0)=D0  S Y(1)=$S( $D(^VA(200 ,D0,"USC2" )):^("USC2 "),1:"") S  X=$P(Y(1) ,U,4),X=X  S DIU=X K  Y S X="" X  ^DD(200,8 932.3,1,1, 2.4)
  12407   "^DD",200, 200,8932.3 ,1,1,2.4)
  12408   S DIH=$S($ D(^VA(200, DIV(0),"US C2")):^("U SC2"),1:"" ),DIV=X S  $P(^("USC2 "),U,4)=DI V,DIH=200, DIG=8932.3 1 D ^DICR: $O(^DD(DIH ,DIG,1,0)) >0
  12409   "^DD",200, 200,8932.3 ,1,1,"CREA TE VALUE")
  12410   TODAY
  12411   "^DD",200, 200,8932.3 ,1,1,"DELE TE VALUE")
  12412   @
  12413   "^DD",200, 200,8932.3 ,1,1,"FIEL D")
  12414   FY as
  12415   "^DD",200, 200,8932.3 ,3)
  12416   Type a Num ber betwee n 1 and 9,  0 Decimal  Digits
  12417   "^DD",200, 200,8932.3 ,21,0)
  12418   ^^1^1^2960 614^
  12419   "^DD",200, 200,8932.3 ,21,1,0)
  12420   This field  is the Fe llowship y ear of a p erson.
  12421   "^DD",200, 200,8932.3 ,"DT")
  12422   2960614
  12423   "^DD",200, 200,8932.3 1,0)
  12424   FY assigne d^D^^USC2; 4^S %DT="E X" D ^%DT  S X=Y K:Y< 1 X
  12425   "^DD",200, 200,8932.3 1,5,1,0)
  12426   200^8932.3 ^1
  12427   "^DD",200, 200,8932.3 1,9)
  12428   ^
  12429   "^DD",200, 200,8932.3 1,21,0)
  12430   ^^1^1^2960 614^
  12431   "^DD",200, 200,8932.3 1,21,1,0)
  12432   This field  holds the  Date that  the FYear  field was  edited.
  12433   "^DD",200, 200,8932.3 1,"DT")
  12434   2960614
  12435   "^DD",200, 200,8980.1 6,0)
  12436   PERSON FIL E POINTER^ RP16'^DIC( 16,^0;16^Q
  12437   "^DD",200, 200,8980.1 6,1,0)
  12438   ^.1
  12439   "^DD",200, 200,8980.1 6,1,1,0)
  12440   200^A16
  12441   "^DD",200, 200,8980.1 6,1,1,1)
  12442   S ^VA(200, "A16",$E(X ,1,30),DA) =""
  12443   "^DD",200, 200,8980.1 6,1,1,2)
  12444   K ^VA(200, "A16",$E(X ,1,30),DA)
  12445   "^DD",200, 200,8980.1 6,1,1,3)
  12446   PERSON FIL E CONVERSI ON
  12447   "^DD",200, 200,8980.1 6,1,1,"%D" ,0)
  12448   ^^2^2^2931 208^^
  12449   "^DD",200, 200,8980.1 6,1,1,"%D" ,1,0)
  12450   This X-ref  is to all ow package s to have  a stable w ay to conv ert
  12451   "^DD",200, 200,8980.1 6,1,1,"%D" ,2,0)
  12452   'person fi le pointer s' into 'n ew person  file point ers'.
  12453   "^DD",200, 200,8980.1 6,1,1,"DT" )
  12454   2920730
  12455   "^DD",200, 200,8980.1 6,3)
  12456   Loaded by  cross file  link
  12457   "^DD",200, 200,8980.1 6,9)
  12458   ^
  12459   "^DD",200, 200,8980.1 6,21,0)
  12460   ^^3^3^2920 730^
  12461   "^DD",200, 200,8980.1 6,21,1,0)
  12462   This field  holds a p ointer to  the person  file so t here will  be a way t o
  12463   "^DD",200, 200,8980.1 6,21,2,0)
  12464   provide a  cross refe rence to h elp conver t 'person  file' poin ters into
  12465   "^DD",200, 200,8980.1 6,21,3,0)
  12466   'new perso n file' po inter afte r the pers on file is  removed.
  12467   "^DD",200, 200,8980.1 6,"DT")
  12468   2920730
  12469   "^DD",200, 200,8983.1 1,0)
  12470   DISPLAY HE LP AT ENTR Y TO LM^S^ y:YES;n:NO ;^LM;1^Q
  12471   "^DD",200, 200,8983.1 1,3)
  12472   Enter yes  to display  the help  text befor e entering  the edito r.
  12473   "^DD",200, 200,8983.1 1,21,0)
  12474   ^^2^2^2890 831^
  12475   "^DD",200, 200,8983.1 1,21,1,0)
  12476   If set to  yes, a hel p text wil l be displ ayed befor e entering  the edito r.
  12477   "^DD",200, 200,8983.1 1,21,2,0)
  12478   This is us ed primari ly for new  users.
  12479   "^DD",200, 200,8983.1 1,"DT")
  12480   2900126
  12481   "^DD",200, 200,8983.1 2,0)
  12482   ASK TERMIN AL TYPE AT  LM ENTRY^ S^y:YES;n: NO;^LM;2^Q
  12483   "^DD",200, 200,8983.1 2,3)
  12484   Enter yes  to ask the  terminal  type upon  entry to t he editor.
  12485   "^DD",200, 200,8983.1 2,21,0)
  12486   ^^1^1^2890 831^
  12487   "^DD",200, 200,8983.1 2,21,1,0)
  12488   If set to  yes, the t erminal ty pe will be  asked upo n entry to  the edito r.
  12489   "^DD",200, 200,8983.1 3,0)
  12490   DEFAULT TE RMINAL TYP E FOR LM^P 3.2'^%ZIS( 2,^LM;3^Q
  12491   "^DD",200, 200,8983.1 3,21,0)
  12492   ^^1^1^2890 831^^
  12493   "^DD",200, 200,8983.1 3,21,1,0)
  12494   This field  stores th e default  terminal t ype for a  user.
  12495   "^DD",200, 200,8983.1 3,"DT")
  12496   2900126
  12497   "^DD",200, 200,8983.1 4,0)
  12498   DISPLAY LM  COMMANDS^ S^y:YES;n: NO;^LM;4^Q
  12499   "^DD",200, 200,8983.1 4,3)
  12500   Enter yes  to display  the list  of command s when ent ering the  command mo de.
  12501   "^DD",200, 200,8983.1 4,21,0)
  12502   ^^2^2^2890 831^
  12503   "^DD",200, 200,8983.1 4,21,1,0)
  12504   If set to  yes, the l ist of com mands will  be displa yed at the  bottom
  12505   "^DD",200, 200,8983.1 4,21,2,0)
  12506   of the scr een when e ntering th e command  mode.
  12507   "^DD",200, 200,8983.1 4,"DT")
  12508   2900126
  12509   "^DD",200, 200,8983.1 5,0)
  12510   BRIGHT CHA RS AT EXIT  FROM LM^S ^y:YES;n:N O;^LM;5^Q
  12511   "^DD",200, 200,8983.1 5,3)
  12512   Enter yes  to leave t he termina l in high  intensity  after exit ing Letter Man.
  12513   "^DD",200, 200,8983.1 5,21,0)
  12514   ^^1^1^2890 831^^
  12515   "^DD",200, 200,8983.1 5,21,1,0)
  12516   If set to  yes, the t erminal wi ll be left  in high i ntensity a fter exiti ng.
  12517   "^DD",200, 200,8983.1 5,"DT")
  12518   2900126
  12519   "^DD",200, 200,8983.1 6,0)
  12520   DATE LAST  ACCESSED L M WP^D^^LM ;6^S %DT=" ETR" D ^%D T S X=Y K: Y<1 X
  12521   "^DD",200, 200,8983.1 6,21,0)
  12522   ^^2^2^2900 128^^^
  12523   "^DD",200, 200,8983.1 6,21,1,0)
  12524   The date a nd time a  user last  accessed t he LetterM an word pr ocessor
  12525   "^DD",200, 200,8983.1 6,21,2,0)
  12526   document e ditor.
  12527   "^DD",200, 200,8983.1 6,"DT")
  12528   2900128
  12529   "^DD",200, 200,8983.1 7,0)
  12530   TOTAL MINU TES USING  LM WP^NJ9, 0^^LM;7^K: +X'=X!(X>9 99999999)! (X<0)!(X?. E1"."1N.N)  X
  12531   "^DD",200, 200,8983.1 7,3)
  12532   Enter the  total minu tes spent  using the  LetterMan  Word Proce ssor (Edit or), from  0 to 99999 9999.
  12533   "^DD",200, 200,8983.1 7,21,0)
  12534   ^^2^2^2900 128^^
  12535   "^DD",200, 200,8983.1 7,21,1,0)
  12536   The total  minutes a  user has u sed the Le tterMan wo rd process or
  12537   "^DD",200, 200,8983.1 7,21,2,0)
  12538   document e ditor.
  12539   "^DD",200, 200,8983.1 7,"DT")
  12540   2900128
  12541   "^DD",200, 200,8983.1 8,0)
  12542   KEYSTROKES  FROM LM W P^NJ9,0^^L M;8^K:+X'= X!(X>99999 9999)!(X<0 )!(X?.E1". "1N.N) X
  12543   "^DD",200, 200,8983.1 8,3)
  12544   Enter the  total numb er of keys trokes a u ser has ty ped from t he word pr ocessor do cument edi tor, from  0 to 99999 9999.
  12545   "^DD",200, 200,8983.1 8,21,0)
  12546   ^^2^2^2900 128^
  12547   "^DD",200, 200,8983.1 8,21,1,0)
  12548   This field  stores th e total nu mber of ke ystrokes a  user has  typed from
  12549   "^DD",200, 200,8983.1 8,21,2,0)
  12550   the word p rocessor d ocument ed itor.
  12551   "^DD",200, 200,8983.1 8,"DT")
  12552   2900128
  12553   "^DD",200, 200,8983.5 ,0)
  12554   SPELLING E XCEPTION D ICTIONARY^ 200.008983 1^^LM1;0
  12555   "^DD",200, 200,8983.5 ,21,0)
  12556   ^^1^1^2900 126^
  12557   "^DD",200, 200,8983.5 ,21,1,0)
  12558   This field  stores th e exceptio n spelling  dictionar y for the  user.
  12559   "^DD",200, 200,8983.5 1,0)
  12560   DEFINED FO RMATS FOR  LM^200.008 9832I^^LM2 ;0
  12561   "^DD",200, 200,8983.5 1,21,0)
  12562   ^^2^2^2900 126^
  12563   "^DD",200, 200,8983.5 1,21,1,0)
  12564   This field  is used t o store pr edefined f ormat line s which a  user can
  12565   "^DD",200, 200,8983.5 1,21,2,0)
  12566   select fro m during e diting.
  12567   "^DD",200, 200,8983.5 2,0)
  12568   DEFINED PH RASES FOR  LM^200.008 9833^^LM3; 0
  12569   "^DD",200, 200,8983.5 2,21,0)
  12570   ^^1^1^2900 126^
  12571   "^DD",200, 200,8983.5 2,21,1,0)
  12572   This field  stores pr edefined p hrases whi ch can be  inserted i nto the do cument dur ing editin g.
  12573   "^DD",200, 200,8983.6 ,0)
  12574   LM LIMIT W P FIELDS T O EDIT^200 .0089834^^ LM4;0
  12575   "^DD",200, 200,8983.6 ,21,0)
  12576   ^^2^2^2901 212^
  12577   "^DD",200, 200,8983.6 ,21,1,0)
  12578   This field  is used b y the user  to limit  which word  processin g
  12579   "^DD",200, 200,8983.6 ,21,2,0)
  12580   fields sho uld be edi ted by Let terMan.
  12581   "^DD",200, 200,9000,0 )
  12582   VPID^F^^VP ID;1^K:$L( X)>25!($L( X)<10) X
  12583   "^DD",200, 200,9000,. 1)
  12584   VA Person  Identifica tion Code
  12585   "^DD",200, 200,9000,1 ,0)
  12586   ^.1^^-1
  12587   "^DD",200, 200,9000,1 ,1,0)
  12588   200^AVPID
  12589   "^DD",200, 200,9000,1 ,1,1)
  12590   S ^VA(200, "AVPID",$E (X,1,30),D A)=""
  12591   "^DD",200, 200,9000,1 ,1,2)
  12592   K ^VA(200, "AVPID",$E (X,1,30),D A)
  12593   "^DD",200, 200,9000,1 ,1,"%D",0)
  12594   ^^2^2^3030 811^
  12595   "^DD",200, 200,9000,1 ,1,"%D",1, 0)
  12596   Index of e ntries by  VPID.  Wil l be used  by Person  Service wh en the 
  12597   "^DD",200, 200,9000,1 ,1,"%D",2, 0)
  12598   XUPSVPID r emote proc edure is e xecuted.
  12599   "^DD",200, 200,9000,1 ,1,"DT")
  12600   3030811
  12601   "^DD",200, 200,9000,3 )
  12602   Answer mus t be 10-25  character s in lengt h.
  12603   "^DD",200, 200,9000,2 1,0)
  12604   ^^2^2^3031 203^
  12605   "^DD",200, 200,9000,2 1,1,0)
  12606   The VA Per son Identi fication N umber whic h was assi gned by th e Person
  12607   "^DD",200, 200,9000,2 1,2,0)
  12608   Service ce ntral syst em.  Used  to uniquel y identify  a Person.
  12609   "^DD",200, 200,9000," DT")
  12610   3031203
  12611   "^DD",200, 200.005,0)
  12612   NETWORK AD DRESS SUB- FIELD^^99^ 14
  12613   "^DD",200, 200.005,0, "DT")
  12614   2910620
  12615   "^DD",200, 200.005,0, "IX","B",2 00.005,.01 )
  12616  
  12617   "^DD",200, 200.005,0, "NM","NETW ORK ADDRES S")
  12618  
  12619   "^DD",200, 200.005,0, "UP")
  12620   200
  12621   "^DD",200, 200.005,.0 1,0)
  12622   NETWORK AD DRESS LAST NAME^F^^0; 1^K:$L(X)> 30!($L(X)< 3) X
  12623   "^DD",200, 200.005,.0 1,1,0)
  12624   ^.1
  12625   "^DD",200, 200.005,.0 1,1,1,0)
  12626   200.005^B
  12627   "^DD",200, 200.005,.0 1,1,1,1)
  12628   S ^VA(200, DA(1),500, "B",$E(X,1 ,30),DA)=" "
  12629   "^DD",200, 200.005,.0 1,1,1,2)
  12630   K ^VA(200, DA(1),500, "B",$E(X,1 ,30),DA)
  12631   "^DD",200, 200.005,.0 1,3)
  12632   Answer mus t be 3-30  characters  in length .
  12633   "^DD",200, 200.005,.0 1,21,0)
  12634   ^^1^1^2910 621^^^^
  12635   "^DD",200, 200.005,.0 1,21,1,0)
  12636   This is th e last nam e of the u ser.
  12637   "^DD",200, 200.005,.0 1,"DT")
  12638   2910620
  12639   "^DD",200, 200.005,1, 0)
  12640   NETWORK AD DRESS FIRS T NAME^RF^ ^0;2^K:$L( X)>30!($L( X)<2) X
  12641   "^DD",200, 200.005,1, 3)
  12642   Answer mus t be 2-30  characters  in length .
  12643   "^DD",200, 200.005,1, 21,0)
  12644   ^^1^1^2901 129^
  12645   "^DD",200, 200.005,1, 21,1,0)
  12646   The recipi ent's firs t name sho uld be ent ered into  this field .
  12647   "^DD",200, 200.005,1, "DT")
  12648   2901129
  12649   "^DD",200, 200.005,2, 0)
  12650   X.400 USER  ID^F^^0;3 ^K:$L(X)>3 0!($L(X)<2 ) X
  12651   "^DD",200, 200.005,2, 3)
  12652   Answer mus t be 2-30  characters  in length .
  12653   "^DD",200, 200.005,2, 21,0)
  12654   ^^1^1^2901 129^
  12655   "^DD",200, 200.005,2, 21,1,0)
  12656   Enter a st ring that  uniquely i dentifies  the user a t the remo te system.
  12657   "^DD",200, 200.005,2, "DT")
  12658   2901129
  12659   "^DD",200, 200.005,3, 0)
  12660   GENERATION ^F^^0;4^K: $L(X)>9!($ L(X)<1) X
  12661   "^DD",200, 200.005,3, 3)
  12662   Answer mus t be 1-9 c haracters  in length.
  12663   "^DD",200, 200.005,3, 21,0)
  12664   ^^2^2^2901 129^
  12665   "^DD",200, 200.005,3, 21,1,0)
  12666   The genera tion of th e recipien t is a suf fix that f urther ide ntifies hi m.
  12667   "^DD",200, 200.005,3, 21,2,0)
  12668   Common str ings used  as such su ffixes are : 'junior' , 'senior' , 'III'.
  12669   "^DD",200, 200.005,3, "DT")
  12670   2901129
  12671   "^DD",200, 200.005,4, 0)
  12672   COUNTRY^S^ US:US;^0;5 ^Q
  12673   "^DD",200, 200.005,4, 21,0)
  12674   ^^4^4^2901 129^
  12675   "^DD",200, 200.005,4, 21,1,0)
  12676   All X.400  addresses  require a  'country'.   If no co untry is k nown this  system
  12677   "^DD",200, 200.005,4, 21,2,0)
  12678   will not d eliver the  mail.  As  of 11/90  'US' was t he only va lid countr y.
  12679   "^DD",200, 200.005,4, 21,3,0)
  12680   SMTP addre sses such  as 'name@d omain' whe re domain  ends with  such strin gs as
  12681   "^DD",200, 200.005,4, 21,4,0)
  12682   '.EDU' nee d no count ry.
  12683   "^DD",200, 200.005,4, "DT")
  12684   2901129
  12685   "^DD",200, 200.005,5, 0)
  12686   ORGANIZATI ON^F^^1;1^ K:$L(X)>30 !($L(X)<2)  X
  12687   "^DD",200, 200.005,5, 3)
  12688   Answer mus t be 2-30  characters  in length .
  12689   "^DD",200, 200.005,5, 21,0)
  12690   ^^6^6^2901 129^
  12691   "^DD",200, 200.005,5, 21,1,0)
  12692   If you are  filling i n this fie ld for an  X.400 addr ess, it is  a standar d
  12693   "^DD",200, 200.005,5, 21,2,0)
  12694   field.  If , however,  you are f illing in  this field  for an SM TP address ,
  12695   "^DD",200, 200.005,5, 21,3,0)
  12696   you must f ill in the  third lev el of the  domain.  F or example , the thir d
  12697   "^DD",200, 200.005,5, 21,4,0)
  12698   level of t he domain  'SILVER.FO RUM.VA.GOV ' is the s tring afte r the seco nd
  12699   "^DD",200, 200.005,5, 21,5,0)
  12700   "." starti ng from th e right.   'GOV' is t he first.   'VA' is t he second.
  12701   "^DD",200, 200.005,5, 21,6,0)
  12702   'SILVER' i s the four th level.
  12703   "^DD",200, 200.005,5, "DT")
  12704   2901129
  12705   "^DD",200, 200.005,5. 1,0)
  12706   ORGANIZATI ONAL UNIT  sub0^F^^1; 2^K:$L(X)> 30!($L(X)< 2) X
  12707   "^DD",200, 200.005,5. 1,3)
  12708   Answer mus t be 2-30  characters  in length .
  12709   "^DD",200, 200.005,5. 1,21,0)
  12710   ^^4^4^2901 129^^
  12711   "^DD",200, 200.005,5. 1,21,1,0)
  12712   This field  contains  the 'Orgai nzational  Unit' of t he address  if it is  the
  12713   "^DD",200, 200.005,5. 1,21,2,0)
  12714   address of  an X.400  recipient.   IF it is  the addre ss of an S MTP recipi ent,
  12715   "^DD",200, 200.005,5. 1,21,3,0)
  12716   this is th e FOURTH L EVEL NAME  of the DOM AIN.  See  the ORGANI ZATION fie ld
  12717   "^DD",200, 200.005,5. 1,21,4,0)
  12718   for a desc ription of  domain le vels of SM TP domains .
  12719   "^DD",200, 200.005,5. 1,"DT")
  12720   2901129
  12721   "^DD",200, 200.005,5. 2,0)
  12722   ORGANIZATI ONAL UNIT  sub1^F^^1; 3^K:$L(X)> 30!($L(X)< 2) X
  12723   "^DD",200, 200.005,5. 2,3)
  12724   Answer mus t be 2-30  characters  in length .
  12725   "^DD",200, 200.005,5. 2,21,0)
  12726   ^^7^7^2901 129^
  12727   "^DD",200, 200.005,5. 2,21,1,0)
  12728   The Organi zational U nit field  of X.400 r ecipients  is infinit ely repeat ing.
  12729   "^DD",200, 200.005,5. 2,21,2,0)
  12730   This syste m will onl y be able  to handle  4 levels o f Organiza tional Uni ts.
  12731   "^DD",200, 200.005,5. 2,21,3,0)
  12732   SMTP domai ns also ha ve levels.   Each Org anizationa l Unit 'su bn' field  is
  12733   "^DD",200, 200.005,5. 2,21,4,0)
  12734   a deeper d efinition  (and level ) of the S MTP domain .  'Sub1'  is the fif t
  12735   "^DD",200, 200.005,5. 2,21,5,0)
  12736   level of t he domain  field.  'S ub2' is th e sixth le vel. 'Sub3 ' is the s eventh.
  12737   "^DD",200, 200.005,5. 2,21,6,0)
  12738   See the de scription  of the ORG ANIZATION  field for  further in formation  on
  12739   "^DD",200, 200.005,5. 2,21,7,0)
  12740   levels of  SMTP domai ns.
  12741   "^DD",200, 200.005,5. 2,"DT")
  12742   2901129
  12743   "^DD",200, 200.005,5. 3,0)
  12744   ORGANIZATI ONAL UNIT  sub2^F^^1; 4^K:$L(X)> 30!($L(X)< 2) X
  12745   "^DD",200, 200.005,5. 3,3)
  12746   Answer mus t be 2-30  characters  in length .
  12747   "^DD",200, 200.005,5. 3,21,0)
  12748   ^^2^2^2901 129^
  12749   "^DD",200, 200.005,5. 3,21,1,0)
  12750   See the de scription  of the 'OR GANIZATION AL UNIT su b1' field  for furthe r
  12751   "^DD",200, 200.005,5. 3,21,2,0)
  12752   informatio n.
  12753   "^DD",200, 200.005,5. 3,"DT")
  12754   2901129
  12755   "^DD",200, 200.005,5. 4,0)
  12756   ORGANIZATI ONAL UNIT  sub3^F^^1; 5^K:$L(X)> 30!($L(X)< 2) X
  12757   "^DD",200, 200.005,5. 4,3)
  12758   Answer mus t be 2-30  characters  in length .
  12759   "^DD",200, 200.005,5. 4,21,0)
  12760   ^^2^2^2901 129^
  12761   "^DD",200, 200.005,5. 4,21,1,0)
  12762   See the de scription  of the 'OR GANIZATION AL UNIT SU B1' field  for furthe r
  12763   "^DD",200, 200.005,5. 4,21,2,0)
  12764   informatio n.
  12765   "^DD",200, 200.005,5. 4,"DT")
  12766   2901129
  12767   "^DD",200, 200.005,6, 0)
  12768   LOCALITY^F ^^0;6^K:$L (X)>30!($L (X)<3) X
  12769   "^DD",200, 200.005,6, 3)
  12770   Answer mus t be 3-30  characters  in length .
  12771   "^DD",200, 200.005,6, "DT")
  12772   2901129
  12773   "^DD",200, 200.005,7, 0)
  12774   APPLICATIO N ENTITY^F ^^0;7^K:$L (X)>30!($L (X)<3) X
  12775   "^DD",200, 200.005,7, 3)
  12776   Answer mus t be 3-30  characters  in length .
  12777   "^DD",200, 200.005,7, 21,0)
  12778   ^^2^2^2901 129^
  12779   "^DD",200, 200.005,7, 21,1,0)
  12780   The 'Appli cation Ent ity' field  is the na me of a pi ece of sof tware that  will
  12781   "^DD",200, 200.005,7, 21,2,0)
  12782   receive an d process  any messag es it rece ives.
  12783   "^DD",200, 200.005,7, "DT")
  12784   2901129
  12785   "^DD",200, 200.005,98 ,0)
  12786   PRIVATE AD MINISTRATI VE DOMAIN^ F^^0;9^K:$ L(X)>30!($ L(X)<3) X
  12787   "^DD",200, 200.005,98 ,3)
  12788   Answer mus t be 3-30  characters  in length .
  12789   "^DD",200, 200.005,98 ,21,0)
  12790   ^^7^7^2901 129^
  12791   "^DD",200, 200.005,98 ,21,1,0)
  12792   For X.400  addresses  this field  is standa rd.  For m apping int o the SMTP
  12793   "^DD",200, 200.005,98 ,21,2,0)
  12794   mail syste m (MailMan  is an SMT P mail sys tem.), thi s field is  filled in
  12795   "^DD",200, 200.005,98 ,21,3,0)
  12796   with a spe cial strin g.  'DHCP'  will be i nterpreted  as ".VA.G OV" for al l
  12797   "^DD",200, 200.005,98 ,21,4,0)
  12798   Department  of Vetera ns' Affair s SMTP sys tems.  If  the addres s does hav e
  12799   "^DD",200, 200.005,98 ,21,5,0)
  12800   "DHCP' in  this field , MailMan  will try t o deliver  it to a VA  site.  If
  12801   "^DD",200, 200.005,98 ,21,6,0)
  12802   the addres s has anyt hing else,  MailMan w ill try to  deliver t o an X.400
  12803   "^DD",200, 200.005,98 ,21,7,0)
  12804   system as  of 11/90.   Later the re may be  additional  special P RMDs.
  12805   "^DD",200, 200.005,98 ,"DT")
  12806   2901129
  12807   "^DD",200, 200.005,99 ,0)
  12808   ADMINISTRA TIVE DOMAI N^F^^0;8^K :$L(X)>30! ($L(X)<2)  X
  12809   "^DD",200, 200.005,99 ,3)
  12810   Answer mus t be 2-30  characters  in length .
  12811   "^DD",200, 200.005,99 ,21,0)
  12812   ^^3^3^2901 129^^
  12813   "^DD",200, 200.005,99 ,21,1,0)
  12814   The Admini strative d omain is t he carrier  of the el ectronic c hannels.   Some
  12815   "^DD",200, 200.005,99 ,21,2,0)
  12816   examples o f carriers  in the US  are US SP RINT, AT&T  and MCI C ommunicati ons.
  12817   "^DD",200, 200.005,99 ,21,3,0)
  12818   This field  is requir ed only fo r X.400 ad dresses.
  12819   "^DD",200, 200.005,99 ,"DT")
  12820   2901129
  12821   "^DD",200, 200.008983 1,0)
  12822   SPELLING E XCEPTION D ICTIONARY  SUB-FIELD^ ^.01^1
  12823   "^DD",200, 200.008983 1,0,"IX"," B",200.008 9831,.01)
  12824  
  12825   "^DD",200, 200.008983 1,0,"NM"," SPELLING E XCEPTION D ICTIONARY" )
  12826  
  12827   "^DD",200, 200.008983 1,0,"UP")
  12828   200
  12829   "^DD",200, 200.008983 1,.01,0)
  12830   WORD^MFX^^ 0;1^K:$L(X )>30!($L(X )<1) X I $ D(X),X'?.L ,X'["-" K  X
  12831   "^DD",200, 200.008983 1,.01,1,0)
  12832   ^.1
  12833   "^DD",200, 200.008983 1,.01,1,1, 0)
  12834   200.008983 1^B
  12835   "^DD",200, 200.008983 1,.01,1,1, 1)
  12836   S ^VA(200, DA(1),"LM1 ","B",$E(X ,1,30),DA) =""
  12837   "^DD",200, 200.008983 1,.01,1,1, 2)
  12838   K ^VA(200, DA(1),"LM1 ","B",$E(X ,1,30),DA)
  12839   "^DD",200, 200.008983 1,.01,3)
  12840   Enter the  WORD which  should be  checked b y the spel ling check er, from 1  to 30 low er case ch aracters i ncluding ' -'.
  12841   "^DD",200, 200.008983 1,.01,21,0 )
  12842   ^^1^1^2900 126^
  12843   "^DD",200, 200.008983 1,.01,21,1 ,0)
  12844   This field  stores wo rds which  will be ch ecked when  spell che cking a do cument.
  12845   "^DD",200, 200.008983 1,.01,"DT" )
  12846   2900126
  12847   "^DD",200, 200.008983 2,0)
  12848   DEFINED FO RMATS FOR  LM SUB-FIE LD^^2^3
  12849   "^DD",200, 200.008983 2,0,"IX"," AC",200.00 89832,1)
  12850  
  12851   "^DD",200, 200.008983 2,0,"IX"," B",200.008 9832,.01)
  12852  
  12853   "^DD",200, 200.008983 2,0,"NM"," DEFINED FO RMATS FOR  LM")
  12854  
  12855   "^DD",200, 200.008983 2,0,"UP")
  12856   200
  12857   "^DD",200, 200.008983 2,.01,0)
  12858   NUMBER^MNJ 7,0^^0;1^K :+X'=X!(X> 9999999)!( X<1)!(X?.E 1"."1N.N)  X
  12859   "^DD",200, 200.008983 2,.01,1,0)
  12860   ^.1
  12861   "^DD",200, 200.008983 2,.01,1,1, 0)
  12862   200.008983 2^B
  12863   "^DD",200, 200.008983 2,.01,1,1, 1)
  12864   S ^VA(200, DA(1),"LM2 ","B",$E(X ,1,30),DA) =""
  12865   "^DD",200, 200.008983 2,.01,1,1, 2)
  12866   K ^VA(200, DA(1),"LM2 ","B",$E(X ,1,30),DA)
  12867   "^DD",200, 200.008983 2,.01,3)
  12868   Enter the  number of  the predef ined forma t line, fr om 1 to 99 99999.
  12869   "^DD",200, 200.008983 2,.01,21,0 )
  12870   ^^1^1^2900 126^
  12871   "^DD",200, 200.008983 2,.01,21,1 ,0)
  12872   This is th e referenc e number t o the pred efined for mat line.
  12873   "^DD",200, 200.008983 2,.01,"DT" )
  12874   2900126
  12875   "^DD",200, 200.008983 2,1,0)
  12876   DEFAULT^S^ y:YES;n:NO ;^0;2^Q
  12877   "^DD",200, 200.008983 2,1,1,0)
  12878   ^.1
  12879   "^DD",200, 200.008983 2,1,1,1,0)
  12880   200.008983 2^AC
  12881   "^DD",200, 200.008983 2,1,1,1,1)
  12882   S ^VA(200, DA(1),"LM2 ","AC",$E( X,1,30),DA )=""
  12883   "^DD",200, 200.008983 2,1,1,1,2)
  12884   K ^VA(200, DA(1),"LM2 ","AC",$E( X,1,30),DA )
  12885   "^DD",200, 200.008983 2,1,3)
  12886   Enter yes  to use thi s format l ine when y ou enter t he screen  editor.
  12887   "^DD",200, 200.008983 2,1,21,0)
  12888   ^^3^3^2900 126^
  12889   "^DD",200, 200.008983 2,1,21,1,0 )
  12890   If set to  yes, this  format lin e will be  used as th e default  format lin e
  12891   "^DD",200, 200.008983 2,1,21,2,0 )
  12892   when using  the scree n editor.   If a docu ment alrea dy has a f ormat line
  12893   "^DD",200, 200.008983 2,1,21,3,0 )
  12894   defined, t hen the do cument for mat will b e used.
  12895   "^DD",200, 200.008983 2,1,"DT")
  12896   2900126
  12897   "^DD",200, 200.008983 2,2,0)
  12898   FORMAT LIN E^FX^^0;3^ K:$L(X)>79 !($L(X)<1)  X I $D(X)  S %=X,X=" WPSEPHR1"  X ^%ZOSF(" TEST") K X  I $T S X= % D CHECK^ WPSEPHR1
  12899   "^DD",200, 200.008983 2,2,3)
  12900   The format  line shou ld contain  dots '.'  representi ng spaces  or 'T' rep resenting  tab or ind ent marker s followed  by a '<'  indicating  the end o f the righ t margin.
  12901   "^DD",200, 200.008983 2,2,21,0)
  12902   ^^1^1^2900 126^
  12903   "^DD",200, 200.008983 2,2,21,1,0 )
  12904   This field  stores th e predefin ed format  lines of t he user.
  12905   "^DD",200, 200.008983 2,2,"DT")
  12906   2900710
  12907   "^DD",200, 200.008983 3,0)
  12908   DEFINED PH RASES FOR  LM SUB-FIE LD^^1^2
  12909   "^DD",200, 200.008983 3,0,"IX"," B",200.008 9833,.01)
  12910  
  12911   "^DD",200, 200.008983 3,0,"NM"," DEFINED PH RASES FOR  LM")
  12912  
  12913   "^DD",200, 200.008983 3,0,"UP")
  12914   200
  12915   "^DD",200, 200.008983 3,.01,0)
  12916   KEYWORD^MF ^^0;1^K:$L (X)>50!($L (X)<1) X
  12917   "^DD",200, 200.008983 3,.01,1,0)
  12918   ^.1
  12919   "^DD",200, 200.008983 3,.01,1,1, 0)
  12920   200.008983 3^B
  12921   "^DD",200, 200.008983 3,.01,1,1, 1)
  12922   S ^VA(200, DA(1),"LM3 ","B",$E(X ,1,30),DA) =""
  12923   "^DD",200, 200.008983 3,.01,1,1, 2)
  12924   K ^VA(200, DA(1),"LM3 ","B",$E(X ,1,30),DA)
  12925   "^DD",200, 200.008983 3,.01,3)
  12926   Enter the  keyword us ed to sele ct this ph rase, from  1 to 50 c haracters.
  12927   "^DD",200, 200.008983 3,.01,21,0 )
  12928   ^^1^1^2900 126^
  12929   "^DD",200, 200.008983 3,.01,21,1 ,0)
  12930   The predef ined phras e 'keyword ' used to  select the  phrase.
  12931   "^DD",200, 200.008983 3,.01,"DT" )
  12932   2900126
  12933   "^DD",200, 200.008983 3,1,0)
  12934   PHRASE^200 .00898331^ ^1;0
  12935   "^DD",200, 200.008983 3,1,21,0)
  12936   ^^1^1^2900 126^
  12937   "^DD",200, 200.008983 3,1,21,1,0 )
  12938   The phrase  to be ins erted into  the docum ent.
  12939   "^DD",200, 200.008983 31,0)
  12940   PHRASE SUB -FIELD^^.0 1^1
  12941   "^DD",200, 200.008983 31,0,"NM", "PHRASE")
  12942  
  12943   "^DD",200, 200.008983 31,0,"UP")
  12944   200.008983 3
  12945   "^DD",200, 200.008983 31,.01,0)
  12946   PHRASE^WL^ ^0;1^Q
  12947   "^DD",200, 200.008983 31,.01,"DT ")
  12948   2900126
  12949   "^DD",200, 200.008983 4,0)
  12950   LM LIMIT W P FIELDS T O EDIT SUB -FIELD^^.0 1^1
  12951   "^DD",200, 200.008983 4,0,"IX"," B",200.008 9834,.01)
  12952  
  12953   "^DD",200, 200.008983 4,0,"NM"," LM LIMIT W P FIELDS T O EDIT")
  12954  
  12955   "^DD",200, 200.008983 4,0,"UP")
  12956   200
  12957   "^DD",200, 200.008983 4,.01,0)
  12958   LM LIMIT W P FIELDS T O EDIT^MFX ^^0;1^K:X[ """"!($A(X )=45) X I  $D(X) K:$L (X)>150!($ L(X)<4) X  I $D(X) S  %=X,X="WPS EFM" X ^%Z OSF("TEST" ) K X I $T  S X=% D S CREEN^WPSE FM
  12959   "^DD",200, 200.008983 4,.01,.1)
  12960   Limited Wo rd-Process ing Fields  to Edit
  12961   "^DD",200, 200.008983 4,.01,1,0)
  12962   ^.1
  12963   "^DD",200, 200.008983 4,.01,1,1, 0)
  12964   200.008983 4^B
  12965   "^DD",200, 200.008983 4,.01,1,1, 1)
  12966   S ^VA(200, DA(1),"LM4 ","B",$E(X ,1,30),DA) =""
  12967   "^DD",200, 200.008983 4,.01,1,1, 2)
  12968   K ^VA(200, DA(1),"LM4 ","B",$E(X ,1,30),DA)
  12969   "^DD",200, 200.008983 4,.01,3)
  12970   Answer mus t be 4-150  character s in lengt h.
  12971   "^DD",200, 200.008983 4,.01,4)
  12972   S X="WPSEH ELP" X ^%Z OSF("TEST" ) I $T D F MHELP^WPSE HELP
  12973   "^DD",200, 200.008983 4,.01,"DT" )
  12974   2901212
  12975   "^DD",200, 200.01,0)
  12976   UCI SUB-FI ELD^NL^2^2
  12977   "^DD",200, 200.01,0," IX","B",20 0.01,.01)
  12978  
  12979   "^DD",200, 200.01,0," NM","UCI")
  12980  
  12981   "^DD",200, 200.01,0," UP")
  12982   200
  12983   "^DD",200, 200.01,.01 ,0)
  12984   UCI^MFX^^0 ;1^K:X[""" "!($A(X)=4 5) X I $D( X) K:$L(X) >30!($L(X) <3) X
  12985   "^DD",200, 200.01,.01 ,1,0)
  12986   ^.1
  12987   "^DD",200, 200.01,.01 ,1,1,0)
  12988   200.01^B
  12989   "^DD",200, 200.01,.01 ,1,1,1)
  12990   S ^VA(200, DA(1),.2," B",$E(X,1, 30),DA)=""
  12991   "^DD",200, 200.01,.01 ,1,1,2)
  12992   K ^VA(200, DA(1),.2," B",$E(X,1, 30),DA)
  12993   "^DD",200, 200.01,.01 ,3)
  12994   THE 3 CHAR . NAME OF  THE UCI'S  THE USER I S ALLOWED  IN
  12995   "^DD",200, 200.01,.01 ,21,0)
  12996   ^^2^2^2920 513^^
  12997   "^DD",200, 200.01,.01 ,21,1,0)
  12998   This is on e of a set  of UCI's  that this  user may c hoose to w ork in
  12999   "^DD",200, 200.01,.01 ,21,2,0)
  13000   at sign-on  time.
  13001   "^DD",200, 200.01,2,0 )
  13002   ROUTINES ( RN1:RN2)^F ^^0;2^K:$L (X)>200!($ L(X)<2) X
  13003   "^DD",200, 200.01,2,3 )
  13004   ENTRY POIN T ROUTINE  NAMES SEPA RATED BY ' :'
  13005   "^DD",200, 200.01,2,2 1,0)
  13006   ^^2^2^2920 513^^
  13007   "^DD",200, 200.01,2,2 1,1,0)
  13008   This is a  list of ro utines tha t the user  may choos e to run w hen signin g on
  13009   "^DD",200, 200.01,2,2 1,2,0)
  13010   to this UC I.  The ro utines are  seperated  by ':'s.
  13011   "^DD",200, 200.010113 ,0)
  13012   CPRS TAB S UB-FIELD^^ .03^3
  13013   "^DD",200, 200.010113 ,0,"DT")
  13014   3020313
  13015   "^DD",200, 200.010113 ,0,"ID","W R1")
  13016   D EN^DDIOL ("   "_$$F MTE^DILIBF ($P(^(0),U ,2),5),"", "?0")
  13017   "^DD",200, 200.010113 ,0,"ID","W R2")
  13018   D EN^DDIOL ("   "_$$F MTE^DILIBF ($P(^(0),U ,3),5),"", "?0")
  13019   "^DD",200, 200.010113 ,0,"IX","B ",200.0101 13,.01)
  13020  
  13021   "^DD",200, 200.010113 ,0,"NM","C PRS TAB")
  13022  
  13023   "^DD",200, 200.010113 ,0,"UP")
  13024   200
  13025   "^DD",200, 200.010113 ,.01,0)
  13026   CPRS TAB^M P101.13'^O RD(101.13, ^0;1^Q
  13027   "^DD",200, 200.010113 ,.01,1,0)
  13028   ^.1
  13029   "^DD",200, 200.010113 ,.01,1,1,0 )
  13030   200.010113 ^B
  13031   "^DD",200, 200.010113 ,.01,1,1,1 )
  13032   S ^VA(200, DA(1),"ORD ","B",$E(X ,1,30),DA) =""
  13033   "^DD",200, 200.010113 ,.01,1,1,2 )
  13034   K ^VA(200, DA(1),"ORD ","B",$E(X ,1,30),DA)
  13035   "^DD",200, 200.010113 ,.01,21,0)
  13036   ^^3^3^3020 314^
  13037   "^DD",200, 200.010113 ,.01,21,1, 0)
  13038   This is a  pointer to  the OR CP RS TABS (# 101.13) fi le. Enter  the name o f
  13039   "^DD",200, 200.010113 ,.01,21,2, 0)
  13040   the CPRS t ab for whi ch you wan t to set e ffective a nd expirat ion dates  for
  13041   "^DD",200, 200.010113 ,.01,21,3, 0)
  13042   access for  this user .
  13043   "^DD",200, 200.010113 ,.01,"DT")
  13044   3020313
  13045   "^DD",200, 200.010113 ,.02,0)
  13046   EFFECTIVE  DATE^RD^^0 ;2^S %DT=" EX" D ^%DT  S X=Y K:Y <1 X
  13047   "^DD",200, 200.010113 ,.02,21,0)
  13048   ^^1^1^3020 315^
  13049   "^DD",200, 200.010113 ,.02,21,1, 0)
  13050   This is th e effectiv e date of  access to  the CPRS t ab.
  13051   "^DD",200, 200.010113 ,.02,"DT")
  13052   3020313
  13053   "^DD",200, 200.010113 ,.03,0)
  13054   EXPIRATION  DATE^D^^0 ;3^S %DT=" EX" D ^%DT  S X=Y K:Y <1 X
  13055   "^DD",200, 200.010113 ,.03,21,0)
  13056   ^^1^1^3020 315^
  13057   "^DD",200, 200.010113 ,.03,21,1, 0)
  13058   This is th e expirati on date of  access to  the CPRS  tab.
  13059   "^DD",200, 200.010113 ,.03,"DT")
  13060   3020313
  13061   "^DD",200, 200.02,0)
  13062   DIVISION S UB-FIELD^N L^1^2
  13063   "^DD",200, 200.02,0," DT")
  13064   3000424
  13065   "^DD",200, 200.02,0," IX","AX1", 200.02,1)
  13066  
  13067   "^DD",200, 200.02,0," IX","B",20 0.02,.01)
  13068  
  13069   "^DD",200, 200.02,0," NM","DIVIS ION")
  13070  
  13071   "^DD",200, 200.02,0," UP")
  13072   200
  13073   "^DD",200, 200.02,.01 ,0)
  13074   DIVISION^P 4'X^DIC(4, ^0;1^S DIN UM=X K:$S( $D(^XUSEC( "XUMGR",DU Z)):0,'$$T F^XUAF4(X) :1,1:0) X, DINUM
  13075   "^DD",200, 200.02,.01 ,1,0)
  13076   ^.1
  13077   "^DD",200, 200.02,.01 ,1,1,0)
  13078   200.02^B
  13079   "^DD",200, 200.02,.01 ,1,1,1)
  13080   S ^VA(200, DA(1),2,"B ",$E(X,1,3 0),DA)=""
  13081   "^DD",200, 200.02,.01 ,1,1,2)
  13082   K ^VA(200, DA(1),2,"B ",$E(X,1,3 0),DA)
  13083   "^DD",200, 200.02,.01 ,1,1,"%D", 0)
  13084   ^^1^1^2990 208^
  13085   "^DD",200, 200.02,.01 ,1,1,"%D", 1,0)
  13086   This is a  standard B  cross-ref erence.
  13087   "^DD",200, 200.02,.01 ,1,1,"DT")
  13088   2990208
  13089   "^DD",200, 200.02,.01 ,1,2,0)
  13090   200^AH
  13091   "^DD",200, 200.02,.01 ,1,2,1)
  13092   S ^VA(200, "AH",$E(X, 1,30),DA(1 ),DA)=""
  13093   "^DD",200, 200.02,.01 ,1,2,2)
  13094   K ^VA(200, "AH",$E(X, 1,30),DA(1 ),DA)
  13095   "^DD",200, 200.02,.01 ,1,2,"DT")
  13096   2991122
  13097   "^DD",200, 200.02,.01 ,3)
  13098   Please ent er the nam e of the D ivision th at the use r may sign -on as a e mployee of .  The Div ision shou ld be an a ctive trea ting facil ity.
  13099   "^DD",200, 200.02,.01 ,21,0)
  13100   ^^1^1^2920 513^^^^
  13101   "^DD",200, 200.02,.01 ,21,1,0)
  13102   The name o f a Divisi on that th is user ma y sign on  to.
  13103   "^DD",200, 200.02,.01 ,"DT")
  13104   3030306
  13105   "^DD",200, 200.02,1,0 )
  13106   DEFAULT^SX ^1:Yes;0:N o;^0;2^I X =1,$D(^VA( 200,DA(1), 2,"AX1",1) ) K X
  13107   "^DD",200, 200.02,1,1 ,0)
  13108   ^.1
  13109   "^DD",200, 200.02,1,1 ,1,0)
  13110   200.02^AX1 ^MUMPS
  13111   "^DD",200, 200.02,1,1 ,1,1)
  13112   S:X=1 ^VA( 200,DA(1), 2,"AX1",X, DA)=""
  13113   "^DD",200, 200.02,1,1 ,1,2)
  13114   K:X=1 ^VA( 200,DA(1), 2,"AX1",X, DA)
  13115   "^DD",200, 200.02,1,1 ,1,3)
  13116   Used to se e that onl y one entr y is marke d as defau lt.
  13117   "^DD",200, 200.02,1,1 ,1,"DT")
  13118   3000424
  13119   "^DD",200, 200.02,1,3 )
  13120   Can only b e set 'yes ' for one  division.
  13121   "^DD",200, 200.02,1,4 )
  13122   N % S %=$O (^VA(200,D A(1),2,"AX 1",1,0)) I  % D EN^DD IOL("Divis ion "_$P($ G(^DIC(4,% ,0)),U)_"  is the def ault",""," ?0")
  13123   "^DD",200, 200.02,1,2 1,0)
  13124   ^.001^4^4^ 3000424^^
  13125   "^DD",200, 200.02,1,2 1,1,0)
  13126   This field  is used t o indicate  that a pa rticular d ivision sh ould be
  13127   "^DD",200, 200.02,1,2 1,2,0)
  13128   presented  to the use r as a def ault when  selecting  a division .  This wi ll
  13129   "^DD",200, 200.02,1,2 1,3,0)
  13130   only affec t users th at have mo re than on e division .
  13131   "^DD",200, 200.02,1,2 1,4,0)
  13132   A cross re ference wi ll only al low one en try to hav e this fla g set.
  13133   "^DD",200, 200.02,1," DT")
  13134   3000424
  13135   "^DD",200, 200.03,0)
  13136   SECONDARY  MENU OPTIO NS SUB-FIE LD^NL^2^2
  13137   "^DD",200, 200.03,0," DT")
  13138   2930105
  13139   "^DD",200, 200.03,0," IX","AC",2 00.03,.01)
  13140  
  13141   "^DD",200, 200.03,0," IX","AOB", 200.03,.01 )
  13142  
  13143   "^DD",200, 200.03,0," IX","B",20 0.03,.01)
  13144  
  13145   "^DD",200, 200.03,0," NM","SECON DARY MENU  OPTIONS")
  13146  
  13147   "^DD",200, 200.03,0," UP")
  13148   200
  13149   "^DD",200, 200.03,.01 ,0)
  13150   SECONDARY  MENU OPTIO NS^M*P19'^ DIC(19,^0; 1^S DIC("S ")="I $D(^ XUSEC(""XU MGR"",DUZ) )!$D(^VA(2 00,DUZ,19. 5,+Y,0))"  D ^DIC K D IC S DIC=D IE,X=+Y K: Y<0 X
  13151   "^DD",200, 200.03,.01 ,1,0)
  13152   ^.1
  13153   "^DD",200, 200.03,.01 ,1,1,0)
  13154   200^AD
  13155   "^DD",200, 200.03,.01 ,1,1,1)
  13156   S ^VA(200, "AD",$E(X, 1,30),DA(1 ),DA)=""
  13157   "^DD",200, 200.03,.01 ,1,1,2)
  13158   K ^VA(200, "AD",$E(X, 1,30),DA(1 ),DA)
  13159   "^DD",200, 200.03,.01 ,1,2,0)
  13160   200^AOA^MU MPS
  13161   "^DD",200, 200.03,.01 ,1,2,1)
  13162   S ^VA(200, DA(1),203. 1)=$H
  13163   "^DD",200, 200.03,.01 ,1,2,2)
  13164   S ^VA(200, DA(1),203. 1)=$H
  13165   "^DD",200, 200.03,.01 ,1,2,3)
  13166   Updates th e timestam p field.
  13167   "^DD",200, 200.03,.01 ,1,3,0)
  13168   200.03^AOB ^MUMPS
  13169   "^DD",200, 200.03,.01 ,1,3,1)
  13170   D REDOXP^X Q7
  13171   "^DD",200, 200.03,.01 ,1,3,2)
  13172   Q
  13173   "^DD",200, 200.03,.01 ,1,3,"%D", 0)
  13174   ^^5^5^2930 415^^
  13175   "^DD",200, 200.03,.01 ,1,3,"%D", 1,0)
  13176   This cross  reference  checks fo r whether  this entry  creates a  new
  13177   "^DD",200, 200.03,.01 ,1,3,"%D", 2,0)
  13178   entry in t he compile d menu tre e in XUTL( "XQO",  If  it is a n ew
  13179   "^DD",200, 200.03,.01 ,1,3,"%D", 3,0)
  13180   entry then  a flag wi ll be set  by the cod e in XQ7 i n the "AT"
  13181   "^DD",200, 200.03,.01 ,1,3,"%D", 4,0)
  13182   cross refe rence of t he option  file (^DIC (19,"AT",   to cause  the
  13183   "^DD",200, 200.03,.01 ,1,3,"%D", 5,0)
  13184   menu tree  to be gene rated.
  13185   "^DD",200, 200.03,.01 ,1,3,"DT")
  13186   2900126
  13187   "^DD",200, 200.03,.01 ,1,4,0)
  13188   200.03^B
  13189   "^DD",200, 200.03,.01 ,1,4,1)
  13190   S ^VA(200, DA(1),203, "B",$E(X,1 ,30),DA)=" "
  13191   "^DD",200, 200.03,.01 ,1,4,2)
  13192   K ^VA(200, DA(1),203, "B",$E(X,1 ,30),DA)
  13193   "^DD",200, 200.03,.01 ,1,4,"DT")
  13194   2960209
  13195   "^DD",200, 200.03,.01 ,1,5,0)
  13196   200.03^AC^ MUMPS
  13197   "^DD",200, 200.03,.01 ,1,5,1)
  13198   D CONTCL^X USTERM1(DA (1))
  13199   "^DD",200, 200.03,.01 ,1,5,2)
  13200   D CONTCL^X USTERM1(DA (1))
  13201   "^DD",200, 200.03,.01 ,1,5,3)
  13202   Clear Cont inue
  13203   "^DD",200, 200.03,.01 ,1,5,"%D", 0)
  13204   ^.101^3^3^ 3020411^^
  13205   "^DD",200, 200.03,.01 ,1,5,"%D", 1,0)
  13206   This X-ref  calls cod e to clear  the follo wing field s  LAST OP TION ACCES SED
  13207   "^DD",200, 200.03,.01 ,1,5,"%D", 2,0)
  13208   (202.1) an d LAST OPT ION MAIN M ENU (202.2 ). This is  too keep  users from
  13209   "^DD",200, 200.03,.01 ,1,5,"%D", 3,0)
  13210   getting as ked to con tinue if t here menu  has change d.
  13211   "^DD",200, 200.03,.01 ,1,5,"DT")
  13212   3020411
  13213   "^DD",200, 200.03,.01 ,3)
  13214   Please ent er a menu- type optio n.
  13215   "^DD",200, 200.03,.01 ,12)
  13216   YOU MUST H AVE XUMGR  OR HAVE BE EN DELEGAT ED THAT OP TION.
  13217   "^DD",200, 200.03,.01 ,12.1)
  13218   S DIC("S") ="I $D(^XU SEC(""XUMG R"",DUZ))! $D(^VA(200 ,DUZ,19.5, +Y,0))"
  13219   "^DD",200, 200.03,.01 ,21,0)
  13220   ^^3^3^2930 415^^^^
  13221   "^DD",200, 200.03,.01 ,21,1,0)
  13222   This is an  option wh ich is mer ged with t he users p rimary men u
  13223   "^DD",200, 200.03,.01 ,21,2,0)
  13224   and XUCOMM AND option , giving t he user th is option  on all of  her/his
  13225   "^DD",200, 200.03,.01 ,21,3,0)
  13226   menus.
  13227   "^DD",200, 200.03,.01 ,"DT")
  13228   3020411
  13229   "^DD",200, 200.03,2,0 )
  13230   SYNONYM^F^ ^0;2^K:X[" """!($A(X) =45) X I $ D(X) K:$L( X)>4!($L(X )<1) X
  13231   "^DD",200, 200.03,2,1 ,0)
  13232   ^.1
  13233   "^DD",200, 200.03,2,1 ,1,0)
  13234   200^AOB^MU MPS
  13235   "^DD",200, 200.03,2,1 ,1,1)
  13236   S ^VA(200, DA(1),203. 1)=$H
  13237   "^DD",200, 200.03,2,1 ,1,2)
  13238   S ^VA(200, DA(1),203. 1)=$H
  13239   "^DD",200, 200.03,2,1 ,1,3)
  13240   Updates th e timestam p field.
  13241   "^DD",200, 200.03,2,3 )
  13242   Answer mus t be 1-4 c haracters  in length.
  13243   "^DD",200, 200.03,2,2 1,0)
  13244   ^^2^2^2930 415^^^^
  13245   "^DD",200, 200.03,2,2 1,1,0)
  13246   This is a  user-speci fic synony m which ma y be used  in address ing this
  13247   "^DD",200, 200.03,2,2 1,2,0)
  13248   option.
  13249   "^DD",200, 200.03,2," AUDIT")
  13250  
  13251   "^DD",200, 200.03,2," DT")
  13252   2910619
  13253   "^DD",200, 200.032,0)
  13254   ACCESSIBLE  FILE SUB- FIELD^^6^8
  13255   "^DD",200, 200.032,0, "DT")
  13256   2920402
  13257   "^DD",200, 200.032,0, "IX","B",2 00.032,.01 )
  13258  
  13259   "^DD",200, 200.032,0, "NM","ACCE SSIBLE FIL E")
  13260  
  13261   "^DD",200, 200.032,0, "UP")
  13262   200
  13263   "^DD",200, 200.032,.0 01,0)
  13264   FILE NUMBE R^NJ16,4^^  ^K:+X'=X! (X>9999999 9999)!(X<1 )!(X?.E1". "5N.N) X
  13265   "^DD",200, 200.032,.0 01,3)
  13266   Type a Num ber betwee n 1 and 99 999999999,  4 Decimal  Digits
  13267   "^DD",200, 200.032,.0 01,21,0)
  13268   ^^2^2^2930 506^^
  13269   "^DD",200, 200.032,.0 01,21,1,0)
  13270   When defin ed, this f ield makes  the sub-f ile's inte rnal entry  number
  13271   "^DD",200, 200.032,.0 01,21,2,0)
  13272   accessible  for inqui ry and edi t.
  13273   "^DD",200, 200.032,.0 01,"DT")
  13274   2920402
  13275   "^DD",200, 200.032,.0 1,0)
  13276   ACCESSIBLE  FILE^M*P1 'X^DIC(^0; 1^S DIC("S ")="I $D(^ VA(200,DUZ ,""FOF"",+ Y,0)),$P(^ (0),U,2)"  S:DUZ(0)[" @" DIC("S" )="I Y>1.1 " D ^DIC K  DIC S DIC =DIE,DINUM =X K:Y<0 X
  13277   "^DD",200, 200.032,.0 1,1,0)
  13278   ^.1
  13279   "^DD",200, 200.032,.0 1,1,1,0)
  13280   200.032^B
  13281   "^DD",200, 200.032,.0 1,1,1,1)
  13282   S ^VA(200, DA(1),"FOF ","B",$E(X ,1,30),DA) =""
  13283   "^DD",200, 200.032,.0 1,1,1,2)
  13284   K ^VA(200, DA(1),"FOF ","B",$E(X ,1,30),DA)
  13285   "^DD",200, 200.032,.0 1,1,2,0)
  13286   200^AFOF
  13287   "^DD",200, 200.032,.0 1,1,2,1)
  13288   S ^VA(200, "AFOF",$E( X,1,30),DA (1),DA)=""
  13289   "^DD",200, 200.032,.0 1,1,2,2)
  13290   K ^VA(200, "AFOF",$E( X,1,30),DA (1),DA)
  13291   "^DD",200, 200.032,.0 1,12)
  13292   Only files  that may  be seen
  13293   "^DD",200, 200.032,.0 1,12.1)
  13294   S DIC("S") ="I $D(^VA (200,DUZ," "FOF"",+Y, 0)),$P(^(0 ),U,2)" S: DUZ(0)["@"  DIC("S")= "I Y>1.1"
  13295   "^DD",200, 200.032,.0 1,"DT")
  13296   2880414
  13297   "^DD",200, 200.032,1, 0)
  13298   DATA DICTI ONARY ACCE SS^S^1:YES ;0:NO;^0;2 ^Q
  13299   "^DD",200, 200.032,1, 21,0)
  13300   ^^2^2^2940 627^^^
  13301   "^DD",200, 200.032,1, 21,1,0)
  13302   This field  is a flag  that, whe n set to 1 , gives th e user dat a dictiona ry
  13303   "^DD",200, 200.032,1, 21,2,0)
  13304   access to  the file ( in the .01  field) re presented  in this re cord.
  13305   "^DD",200, 200.032,1, "DT")
  13306   3030408
  13307   "^DD",200, 200.032,2, 0)
  13308   DELETE ACC ESS^S^1:YE S;0:NO;^0; 3^Q
  13309   "^DD",200, 200.032,2, 3)
  13310  
  13311   "^DD",200, 200.032,2, 21,0)
  13312   ^^2^2^2940 627^^^
  13313   "^DD",200, 200.032,2, 21,1,0)
  13314   This field  is a flag  that, whe n set to 1 , gives th e user del ete access  to
  13315   "^DD",200, 200.032,2, 21,2,0)
  13316   the file ( in the .01  field) re presented  in this re cord.
  13317   "^DD",200, 200.032,2, "DT")
  13318   3030408
  13319   "^DD",200, 200.032,3, 0)
  13320   LAYGO ACCE SS^S^1:YES ;0:NO;^0;4 ^Q
  13321   "^DD",200, 200.032,3, 3)
  13322  
  13323   "^DD",200, 200.032,3, 21,0)
  13324   ^^2^2^2930 506^
  13325   "^DD",200, 200.032,3, 21,1,0)
  13326   This field  is a flag  that, whe n set to 1 , gives th e user LAY GO access  to
  13327   "^DD",200, 200.032,3, 21,2,0)
  13328   the file ( in the .01  field) re presented  in this re cord.
  13329   "^DD",200, 200.032,3, "DT")
  13330   3030408
  13331   "^DD",200, 200.032,4, 0)
  13332   READ ACCES S^S^1:YES; 0:NO;^0;5^ Q
  13333   "^DD",200, 200.032,4, 3)
  13334  
  13335   "^DD",200, 200.032,4, 21,0)
  13336   ^^2^2^2930 506^
  13337   "^DD",200, 200.032,4, 21,1,0)
  13338   This field  is a flag  that, whe n set to 1 , gives th e user rea d access t o
  13339   "^DD",200, 200.032,4, 21,2,0)
  13340   the file ( in the .01  field) re presented  in this re cord.
  13341   "^DD",200, 200.032,4, "DT")
  13342   3030408
  13343   "^DD",200, 200.032,5, 0)
  13344   WRITE ACCE SS^S^1:YES ;0:NO;^0;6 ^Q
  13345   "^DD",200, 200.032,5, 3)
  13346  
  13347   "^DD",200, 200.032,5, 21,0)
  13348   ^^2^2^2930 506^
  13349   "^DD",200, 200.032,5, 21,1,0)
  13350   This field  is a flag  that, whe n set to 1 , gives th e user wri te access  to
  13351   "^DD",200, 200.032,5, 21,2,0)
  13352   the file ( in the .01  field) re presented  in this re cord.
  13353   "^DD",200, 200.032,5, "DT")
  13354   3030408
  13355   "^DD",200, 200.032,6, 0)
  13356   AUDIT ACCE SS^S^1:YES ;0:NO;^0;7 ^Q
  13357   "^DD",200, 200.032,6, 3)
  13358  
  13359   "^DD",200, 200.032,6, 21,0)
  13360   ^^2^2^2930 506^
  13361   "^DD",200, 200.032,6, 21,1,0)
  13362   This field  is a flag  that, whe n set to 1 , gives th e user aud it access  to
  13363   "^DD",200, 200.032,6, 21,2,0)
  13364   the file ( in the .01  field) re presented  in this re cord.
  13365   "^DD",200, 200.032,6, "DT")
  13366   3030408
  13367   "^DD",200, 200.0351,0 )
  13368   PERSONAL D IAGNOSES L IST SUB-FI ELD^^1^2
  13369   "^DD",200, 200.0351,0 ,"DT")
  13370   3040707
  13371   "^DD",200, 200.0351,0 ,"IX","B", 200.0351,. 01)
  13372  
  13373   "^DD",200, 200.0351,0 ,"NM","PER SONAL DIAG NOSES LIST ")
  13374  
  13375   "^DD",200, 200.0351,0 ,"UP")
  13376   200
  13377   "^DD",200, 200.0351,. 01,0)
  13378   DIAGNOSIS^ P80'^ICD9( ^0;1^Q
  13379   "^DD",200, 200.0351,. 01,1,0)
  13380   ^.1
  13381   "^DD",200, 200.0351,. 01,1,1,0)
  13382   200.0351^B
  13383   "^DD",200, 200.0351,. 01,1,1,1)
  13384   S ^VA(200, DA(1),351, "B",$E(X,1 ,30),DA)=" "
  13385   "^DD",200, 200.0351,. 01,1,1,2)
  13386   K ^VA(200, DA(1),351, "B",$E(X,1 ,30),DA)
  13387   "^DD",200, 200.0351,. 01,21,0)
  13388   ^.001^1^1^ 3040707^^
  13389   "^DD",200, 200.0351,. 01,21,1,0)
  13390   A diagnosi s in the p rovider's  preferred  list.
  13391   "^DD",200, 200.0351,. 01,"DT")
  13392   3040302
  13393   "^DD",200, 200.0351,1 ,0)
  13394   EXPRESSION ^P757.01'^ LEX(757.01 ,^0;2^Q
  13395   "^DD",200, 200.0351,1 ,21,0)
  13396   ^.001^3^3^ 3040708^^^ ^
  13397   "^DD",200, 200.0351,1 ,21,1,0)
  13398   This is th e diagnosi s code's L exicon
  13399   "^DD",200, 200.0351,1 ,21,2,0)
  13400   expression  as stored  in the EX PRESSION f ile,
  13401   "^DD",200, 200.0351,1 ,21,3,0)
  13402   file # 757 .01.
  13403   "^DD",200, 200.0351,1 ,"DT")
  13404   3040707
  13405   "^DD",200, 200.04,0)
  13406   ALIAS SUB- FIELD^^.01 ^1
  13407   "^DD",200, 200.04,0," DT")
  13408   2911210
  13409   "^DD",200, 200.04,0," IX","B",20 0.04,.01)
  13410  
  13411   "^DD",200, 200.04,0," NM","ALIAS ")
  13412  
  13413   "^DD",200, 200.04,0," UP")
  13414   200
  13415   "^DD",200, 200.04,.01 ,0)
  13416   ALIAS^MFX^ ^0;1^K:X[" """!($A(X) =45) X I $ D(X) K:$L( X)>35!($L( X)<2)!(X'? 2U.UP) X
  13417   "^DD",200, 200.04,.01 ,1,0)
  13418   ^.1
  13419   "^DD",200, 200.04,.01 ,1,1,0)
  13420   200.04^B
  13421   "^DD",200, 200.04,.01 ,1,1,1)
  13422   S ^VA(200, DA(1),3,"B ",$E(X,1,3 0),DA)=""
  13423   "^DD",200, 200.04,.01 ,1,1,2)
  13424   K ^VA(200, DA(1),3,"B ",$E(X,1,3 0),DA)
  13425   "^DD",200, 200.04,.01 ,1,2,0)
  13426   200^BB
  13427   "^DD",200, 200.04,.01 ,1,2,1)
  13428   S ^VA(200, "BB",$E(X, 1,30),DA(1 ),DA)=""
  13429   "^DD",200, 200.04,.01 ,1,2,2)
  13430   K ^VA(200, "BB",$E(X, 1,30),DA(1 ),DA)
  13431   "^DD",200, 200.04,.01 ,3)
  13432   Answer mus t be 2-35  uppercase  characters  in length .
  13433   "^DD",200, 200.04,.01 ,"DT")
  13434   2911210
  13435   "^DD",200, 200.042,0)
  13436   EFFECTIVE  DATE/TIME  SUB-FIELD^ ^.03^3
  13437   "^DD",200, 200.042,0, "DT")
  13438   3060301
  13439   "^DD",200, 200.042,0, "IX","AC", 200.042,.0 3)
  13440  
  13441   "^DD",200, 200.042,0, "IX","B",2 00.042,.01 )
  13442  
  13443   "^DD",200, 200.042,0, "IX","C",2 00.042,.03 )
  13444  
  13445   "^DD",200, 200.042,0, "NM","EFFE CTIVE DATE /TIME")
  13446  
  13447   "^DD",200, 200.042,0, "UP")
  13448   200
  13449   "^DD",200, 200.042,.0 1,0)
  13450   EFFECTIVE  DATE/TIME^ DX^^0;1^S  %DT="ESTX"  D ^%DT S  X=Y K:Y<1  X
  13451   "^DD",200, 200.042,.0 1,1,0)
  13452   ^.1
  13453   "^DD",200, 200.042,.0 1,1,1,0)
  13454   200.042^B
  13455   "^DD",200, 200.042,.0 1,1,1,1)
  13456   S ^VA(200, DA(1),"NPI STATUS","B ",$E(X,1,3 0),DA)=""
  13457   "^DD",200, 200.042,.0 1,1,1,2)
  13458   K ^VA(200, DA(1),"NPI STATUS","B ",$E(X,1,3 0),DA)
  13459   "^DD",200, 200.042,.0 1,3)
  13460   Enter the  date/time  of the las t change t o this NPI .
  13461   "^DD",200, 200.042,.0 1,21,0)
  13462   ^^1^1^3060 425^
  13463   "^DD",200, 200.042,.0 1,21,1,0)
  13464   This field  contains  the date a nd time of  the last  change to  the NPI fi eld.
  13465   "^DD",200, 200.042,.0 1,"DT")
  13466   3060425
  13467   "^DD",200, 200.042,.0 2,0)
  13468   STATUS^RSI ^1:ACTIVE; 0:INACTIVE ;^0;2^Q
  13469   "^DD",200, 200.042,.0 2,21,0)
  13470   ^.001^4^4^ 3060405^^^
  13471   "^DD",200, 200.042,.0 2,21,1,0)
  13472   The Status  of an NPI  is either  'ACTIVE'  or 'INACTI VE'. I 'AC TIVE' then  
  13473   "^DD",200, 200.042,.0 2,21,2,0)
  13474   the NPI wi ll be acce ssible by  end-users  to documen t a partic ular 
  13475   "^DD",200, 200.042,.0 2,21,3,0)
  13476   provider.  If 'INACTI VE', then  the NPI wi ll only be  accessibl e by the 
  13477   "^DD",200, 200.042,.0 2,21,4,0)
  13478   applicatio n to displ ay legacy  data.
  13479   "^DD",200, 200.042,.0 2,"DT")
  13480   3060301
  13481   "^DD",200, 200.042,.0 3,0)
  13482   NPI^RFX^^0 ;3^K:'($$C HKDGT^XUSN PIE1(X,DA, "Individua l_ID")) X
  13483   "^DD",200, 200.042,.0 3,1,0)
  13484   ^.1
  13485   "^DD",200, 200.042,.0 3,1,1,0)
  13486   200.042^C
  13487   "^DD",200, 200.042,.0 3,1,1,1)
  13488   S ^VA(200, DA(1),"NPI STATUS","C ",$E(X,1,3 0),DA)=""
  13489   "^DD",200, 200.042,.0 3,1,1,2)
  13490   K ^VA(200, DA(1),"NPI STATUS","C ",$E(X,1,3 0),DA)
  13491   "^DD",200, 200.042,.0 3,1,1,"DT" )
  13492   3060301
  13493   "^DD",200, 200.042,.0 3,1,2,0)
  13494   200.042^AC ^MUMPS
  13495   "^DD",200, 200.042,.0 3,1,2,1)
  13496   D SET^XUSN PIE1(DA(1) ,X)
  13497   "^DD",200, 200.042,.0 3,1,2,2)
  13498   Q
  13499   "^DD",200, 200.042,.0 3,1,2,3)
  13500   Special Tr igger
  13501   "^DD",200, 200.042,.0 3,1,2,"%D" ,0)
  13502   ^.101^1^1^ 3060511^^
  13503   "^DD",200, 200.042,.0 3,1,2,"%D" ,1,0)
  13504   This Speci al x-ref s ets the NP I field (# 41.99).
  13505   "^DD",200, 200.042,.0 3,1,2,"DT" )
  13506   3060511
  13507   "^DD",200, 200.042,.0 3,3)
  13508   Answer mus t be 10 di git value  assigned b y Centers  for Medica re and Med icaid Serv ices (CMS) .
  13509   "^DD",200, 200.042,.0 3,21,0)
  13510   ^^6^6^3070 918^
  13511   "^DD",200, 200.042,.0 3,21,1,0)
  13512   Each VHA B illable Pr actitioner  should ha ve applied  for the N PI through
  13513   "^DD",200, 200.042,.0 3,21,2,0)
  13514   CMS' Natio nal Plan a nd Provide r Enumerat ion System  (NPPES).   NPI
  13515   "^DD",200, 200.042,.0 3,21,3,0)
  13516   Confirmati on Letters  are sent  by CMS and  indicate  the NPI as signed.
  13517   "^DD",200, 200.042,.0 3,21,4,0)
  13518   Practition ers may pr esent thei r NPI Conf irmation L etter as a  source
  13519   "^DD",200, 200.042,.0 3,21,5,0)
  13520   document t o verify t he accurac y of the N PI or you  may contac t your Loc al
  13521   "^DD",200, 200.042,.0 3,21,6,0)
  13522   NPI Mainte nance Team  Leader fo r assistan ce.
  13523   "^DD",200, 200.042,.0 3,"DT")
  13524   3070918
  13525   "^DD",200, 200.05,0)
  13526   PERSON CLA SS SUB-FIE LD^^3^3
  13527   "^DD",200, 200.05,0," ACT")
  13528   I $P($G(^V A(200,DA(1 ),"USC1",D A,0)),U,3) >0 S Y=-1
  13529   "^DD",200, 200.05,0," DT")
  13530   2960603
  13531   "^DD",200, 200.05,0," IX","AC",2 00.05,.01)
  13532  
  13533   "^DD",200, 200.05,0," IX","AD",2 00.05,2)
  13534  
  13535   "^DD",200, 200.05,0," IX","AE",2 00.05,2)
  13536  
  13537   "^DD",200, 200.05,0," IX","B",20 0.05,.01)
  13538  
  13539   "^DD",200, 200.05,0," NM","PERSO N CLASS")
  13540  
  13541   "^DD",200, 200.05,0," UP")
  13542   200
  13543   "^DD",200, 200.05,.01 ,0)
  13544   Person Cla ss^*P8932. 1'^USC(893 2.1,^0;1^S  DIC("S")= "I $P(^(0) ,U,4)'[""i """ D ^DIC  K DIC S D IC=DIE,X=+ Y K:Y<0 X
  13545   "^DD",200, 200.05,.01 ,1,0)
  13546   ^.1
  13547   "^DD",200, 200.05,.01 ,1,1,0)
  13548   200.05^B
  13549   "^DD",200, 200.05,.01 ,1,1,1)
  13550   S ^VA(200, DA(1),"USC 1","B",$E( X,1,30),DA )=""
  13551   "^DD",200, 200.05,.01 ,1,1,2)
  13552   K ^VA(200, DA(1),"USC 1","B",$E( X,1,30),DA )
  13553   "^DD",200, 200.05,.01 ,1,2,0)
  13554   200.05^AC^ MUMPS
  13555   "^DD",200, 200.05,.01 ,1,2,1)
  13556   D SET01^XU A4A72
  13557   "^DD",200, 200.05,.01 ,1,2,2)
  13558   Q
  13559   "^DD",200, 200.05,.01 ,1,2,3)
  13560   Special Tr igger
  13561   "^DD",200, 200.05,.01 ,1,2,"%D", 0)
  13562   ^^1^1^2960 603^
  13563   "^DD",200, 200.05,.01 ,1,2,"%D", 1,0)
  13564   This X-ref  triggers  the curren t date int o the Effe ctive Date  field.
  13565   "^DD",200, 200.05,.01 ,1,2,"DT")
  13566   2960603
  13567   "^DD",200, 200.05,.01 ,12)
  13568   Don't allo w Inactive  entries t o be selec ted.
  13569   "^DD",200, 200.05,.01 ,12.1)
  13570   S DIC("S") ="I $P(^(0 ),U,4)'["" i"""
  13571   "^DD",200, 200.05,.01 ,21,0)
  13572   ^^1^1^2960 730^^^
  13573   "^DD",200, 200.05,.01 ,21,1,0)
  13574   This is a  pointer to  the Perso n class fi le.
  13575   "^DD",200, 200.05,.01 ,"DEL",1,0 )
  13576   I 1 ;Don't  allow del ete
  13577   "^DD",200, 200.05,.01 ,"DT")
  13578   2960603
  13579   "^DD",200, 200.05,2,0 )
  13580   Effective  Date^RDX^^ 0;2^N %DT, % S %DT="E X",%=$O(^V A(200,D0," USC1",DA), -1) S:% %= $P($G(^(%, 0)),U,2) S :% %DT(0)= % D ^%DT S  X=Y K:Y<1  X
  13581   "^DD",200, 200.05,2,1 ,0)
  13582   ^.1
  13583   "^DD",200, 200.05,2,1 ,1,0)
  13584   200.05^AD
  13585   "^DD",200, 200.05,2,1 ,1,1)
  13586   S ^VA(200, DA(1),"USC 1","AD",$E (X,1,30),D A)=""
  13587   "^DD",200, 200.05,2,1 ,1,2)
  13588   K ^VA(200, DA(1),"USC 1","AD",$E (X,1,30),D A)
  13589   "^DD",200, 200.05,2,1 ,1,3)
  13590   Don't Dele te
  13591   "^DD",200, 200.05,2,1 ,1,"%D",0)
  13592   ^^2^2^2960 529^
  13593   "^DD",200, 200.05,2,1 ,1,"%D",1, 0)
  13594   This X-ref  is by dat e and allo ws us to f ind the mo st current  entry
  13595   "^DD",200, 200.05,2,1 ,1,"%D",2, 0)
  13596   in the fil e.
  13597   "^DD",200, 200.05,2,1 ,1,"DT")
  13598   2960529
  13599   "^DD",200, 200.05,2,1 ,2,0)
  13600   200.05^AE^ MUMPS
  13601   "^DD",200, 200.05,2,1 ,2,1)
  13602   D SET2^XUA 4A72
  13603   "^DD",200, 200.05,2,1 ,2,2)
  13604   D KILL2^XU A4A72
  13605   "^DD",200, 200.05,2,1 ,2,3)
  13606   Special Tr igger
  13607   "^DD",200, 200.05,2,1 ,2,"%D",0)
  13608   ^^2^2^2960 703^
  13609   "^DD",200, 200.05,2,1 ,2,"%D",1, 0)
  13610   This Speci al X-ref s ets the Ex piration d ate of the  previous  person cla ss
  13611   "^DD",200, 200.05,2,1 ,2,"%D",2, 0)
  13612   entry to t he current  record's  Effective  date.
  13613   "^DD",200, 200.05,2,1 ,2,"DT")
  13614   2960603
  13615   "^DD",200, 200.05,2,3 )
  13616   The date t hat this P erson Clas s became e ffective.
  13617   "^DD",200, 200.05,2,2 1,0)
  13618   ^^1^1^2960 703^^^^
  13619   "^DD",200, 200.05,2,2 1,1,0)
  13620   This field  is trigge r by addin g a new pe rson class .
  13621   "^DD",200, 200.05,2," DT")
  13622   3030424
  13623   "^DD",200, 200.05,3,0 )
  13624   Expiration  Date^DX^^ 0;3^S %DT= "EX" D ^%D T S X=Y I  Y<1!'$$ENT ^XUA4A73(. DA,X) K X
  13625   "^DD",200, 200.05,3,3 )
  13626   Last activ e date. Af ter this d ate the Pe rson Class  is no lon ger valid.
  13627   "^DD",200, 200.05,3,2 1,0)
  13628   ^^7^7^3070 419^
  13629   "^DD",200, 200.05,3,2 1,1,0)
  13630   This field  is the da te after w hich this  class beco mes inacti ve.
  13631   "^DD",200, 200.05,3,2 1,2,0)
  13632   This field  must be n ot less th an the EFF ECTIVE DAT E and not  greater 
  13633   "^DD",200, 200.05,3,2 1,3,0)
  13634   than the D ATE INACTI VATED fiel d(#4) of t he Person  Class entr y in the
  13635   "^DD",200, 200.05,3,2 1,4,0)
  13636   PERSON CLA SS file(#8 932.1).
  13637   "^DD",200, 200.05,3,2 1,5,0)
  13638          
  13639   "^DD",200, 200.05,3,2 1,6,0)
  13640   It will ge t triggere d if a new  Person Cl ass is ent ered or so meone
  13641   "^DD",200, 200.05,3,2 1,7,0)
  13642   edits the  field to i nactivate  the class.
  13643   "^DD",200, 200.05,3," DT")
  13644   3070316
  13645   "^DD",200, 200.051,0)
  13646   KEYS SUB-F IELD^^3^4
  13647   "^DD",200, 200.051,0, "DT")
  13648   2890929
  13649   "^DD",200, 200.051,0, "IX","AC", 200.051,.0 1)
  13650  
  13651   "^DD",200, 200.051,0, "IX","B",2 00.051,.01 )
  13652  
  13653   "^DD",200, 200.051,0, "NM","KEYS ")
  13654  
  13655   "^DD",200, 200.051,0, "UP")
  13656   200
  13657   "^DD",200, 200.051,.0 1,0)
  13658   KEY^M*P19. 1'X^DIC(19 .1,^0;1^S  DIC("S")=" I DUZ(0)=" "@""!$D(^V A(200,DUZ, 52,Y,0))!$ D(^XUSEC(" "XUMGR"",D UZ))" D ^D IC K DIC S  DIC=DIE,X =+Y K:Y<0  X S:$D(X)  DINUM=X
  13659   "^DD",200, 200.051,.0 1,1,0)
  13660   ^.1
  13661   "^DD",200, 200.051,.0 1,1,1,0)
  13662   200.051^B
  13663   "^DD",200, 200.051,.0 1,1,1,1)
  13664   S ^VA(200, DA(1),51," B",$E(X,1, 30),DA)=""
  13665   "^DD",200, 200.051,.0 1,1,1,2)
  13666   K ^VA(200, DA(1),51," B",$E(X,1, 30),DA)
  13667   "^DD",200, 200.051,.0 1,1,2,0)
  13668   200.051^AC ^MUMPS
  13669   "^DD",200, 200.051,.0 1,1,2,1)
  13670   N % S %=$P ($G(^DIC(1 9.1,DA,0)) ,U) S:%]""  ^XUSEC(%, DA(1))=""
  13671   "^DD",200, 200.051,.0 1,1,2,2)
  13672   N % S %=$P ($G(^DIC(1 9.1,DA,0)) ,U) K:%]""  ^XUSEC(%, DA(1))
  13673   "^DD",200, 200.051,.0 1,1,2,3)
  13674   This sets  the XUSEC  X-ref.
  13675   "^DD",200, 200.051,.0 1,1,2,"%D" ,0)
  13676   ^^3^3^2920 121^
  13677   "^DD",200, 200.051,.0 1,1,2,"%D" ,1,0)
  13678   This is th e X-ref th at keeps t he ^XUSEC( keyname,DU Z) global  in place.
  13679   "^DD",200, 200.051,.0 1,1,2,"%D" ,2,0)
  13680   This globa l is used  the menu s ystem and  other to c heck if a  new person
  13681   "^DD",200, 200.051,.0 1,1,2,"%D" ,3,0)
  13682   holds a gi ven key.
  13683   "^DD",200, 200.051,.0 1,1,2,"DT" )
  13684   2920121
  13685   "^DD",200, 200.051,.0 1,1,3,0)
  13686   200^AB
  13687   "^DD",200, 200.051,.0 1,1,3,1)
  13688   S ^VA(200, "AB",$E(X, 1,30),DA(1 ),DA)=""
  13689   "^DD",200, 200.051,.0 1,1,3,2)
  13690   K ^VA(200, "AB",$E(X, 1,30),DA(1 ),DA)
  13691   "^DD",200, 200.051,.0 1,1,3,3)
  13692   X-ref whol e file by  KEY.
  13693   "^DD",200, 200.051,.0 1,1,3,"DT" )
  13694   2890927
  13695   "^DD",200, 200.051,.0 1,1,4,0)
  13696   200^AK^MUM PS
  13697   "^DD",200, 200.051,.0 1,1,4,1)
  13698   G FE51S^XU A4A7
  13699   "^DD",200, 200.051,.0 1,1,4,2)
  13700   G FE51K^XU A4A7
  13701   "^DD",200, 200.051,.0 1,1,4,3)
  13702   Special lo okup X-ref  for Appli cations.
  13703   "^DD",200, 200.051,.0 1,1,4,"%D" ,0)
  13704   ^^2^2^2910 916^
  13705   "^DD",200, 200.051,.0 1,1,4,"%D" ,1,0)
  13706   Special X- ref to all ow applica tions to d o lookup o n just hol ders
  13707   "^DD",200, 200.051,.0 1,1,4,"%D" ,2,0)
  13708   of a speci al key.
  13709   "^DD",200, 200.051,.0 1,1,4,"DT" )
  13710   2910916
  13711   "^DD",200, 200.051,.0 1,1,5,0)
  13712   ^^TRIGGER^ 200.051^1
  13713   "^DD",200, 200.051,.0 1,1,5,1)
  13714   K DIV S DI V=X,D0=DA( 1),DIV(0)= D0,D1=DA,D IV(1)=D1,X =DUZ,DIU=$ P(^VA(200, D0,51,D1,0 ),U,2),$P( ^(0),U,2)= X,DIH=200. 051,DIG=1  D ^DICR:$O (^DD(DIH,D IG,1,0))>0
  13715   "^DD",200, 200.051,.0 1,1,5,2)
  13716   Q
  13717   "^DD",200, 200.051,.0 1,1,5,3)
  13718   Edited tri gger
  13719   "^DD",200, 200.051,.0 1,1,5,"CRE ATE VALUE" )
  13720   S X=DUZ
  13721   "^DD",200, 200.051,.0 1,1,5,"DEL ETE VALUE" )
  13722   NO EFFECT
  13723   "^DD",200, 200.051,.0 1,1,5,"DT" )
  13724   2890927
  13725   "^DD",200, 200.051,.0 1,1,5,"FIE LD")
  13726   GIVEN BY
  13727   "^DD",200, 200.051,.0 1,1,6,0)
  13728   ^^TRIGGER^ 200.051^2
  13729   "^DD",200, 200.051,.0 1,1,6,1)
  13730   K DIV S DI V=X,D0=DA( 1),DIV(0)= D0,D1=DA,D IV(1)=D1,X =DT,DIU=$P (^VA(200,D 0,51,D1,0) ,U,3),$P(^ (0),U,3)=X ,DIH=200.0 51,DIG=2 D  ^DICR:$O( ^DD(DIH,DI G,1,0))>0
  13731   "^DD",200, 200.051,.0 1,1,6,2)
  13732   Q
  13733   "^DD",200, 200.051,.0 1,1,6,3)
  13734   Edited tri gger
  13735   "^DD",200, 200.051,.0 1,1,6,"CRE ATE VALUE" )
  13736   TODAY
  13737   "^DD",200, 200.051,.0 1,1,6,"DEL ETE VALUE" )
  13738   NO EFFECT
  13739   "^DD",200, 200.051,.0 1,1,6,"DT" )
  13740   2890927
  13741   "^DD",200, 200.051,.0 1,1,6,"FIE LD")
  13742   DATE GIVEN
  13743   "^DD",200, 200.051,.0 1,12.1)
  13744   S DIC("S") ="I DUZ(0) =""@""!$D( ^VA(200,DU Z,52,Y,0)) !$D(^XUSEC (""XUMGR"" ,DUZ))"
  13745   "^DD",200, 200.051,.0 1,21,0)
  13746   ^^1^1^2911 212^^
  13747   "^DD",200, 200.051,.0 1,21,1,0)
  13748   This is a  security k ey that th is person  holds.
  13749   "^DD",200, 200.051,.0 1,"DEL",1, 0)
  13750   I $P($G(^D IC(19.1,DA ,0)),U,4)= "Y"
  13751   "^DD",200, 200.051,.0 1,"DT")
  13752   2920121
  13753   "^DD",200, 200.051,.0 1,"LAYGO", 1,0)
  13754   S Y=DA(1)  X:$D(^DIC( 19.1,+X,4) ) ^(4)
  13755   "^DD",200, 200.051,1, 0)
  13756   GIVEN BY^P 200'^VA(20 0,^0;2^Q
  13757   "^DD",200, 200.051,1, 5,1,0)
  13758   200.051^.0 1^5
  13759   "^DD",200, 200.051,1, 9)
  13760   ^
  13761   "^DD",200, 200.051,1, 21,0)
  13762   ^^2^2^2911 212^^
  13763   "^DD",200, 200.051,1, 21,1,0)
  13764   This is a  pointer to  the perso n that ent ered this  security   key into t his
  13765   "^DD",200, 200.051,1, 21,2,0)
  13766   persons fi le.
  13767   "^DD",200, 200.051,1, "DT")
  13768   2890926
  13769   "^DD",200, 200.051,2, 0)
  13770   DATE GIVEN ^D^^0;3^S  %DT="EX" D  ^%DT S X= Y K:Y<1 X
  13771   "^DD",200, 200.051,2, 5,1,0)
  13772   200.051^.0 1^6
  13773   "^DD",200, 200.051,2, 9)
  13774   ^
  13775   "^DD",200, 200.051,2, 21,0)
  13776   ^^2^2^2911 212^^^
  13777   "^DD",200, 200.051,2, 21,1,0)
  13778   This is th e date tha t the secu rity key w as given t o the pers on.
  13779   "^DD",200, 200.051,2, 21,2,0)
  13780   There is k now histor y.
  13781   "^DD",200, 200.051,2, "DT")
  13782   2890926
  13783   "^DD",200, 200.051,3, 0)
  13784   REVIEW DAT E^D^^0;4^S  %DT="E" D  ^%DT S X= Y K:Y<1 X
  13785   "^DD",200, 200.051,3, 3)
  13786   The date a fter which  this pers ons holdin g the key  should be  reviewed.
  13787   "^DD",200, 200.051,3, 21,0)
  13788   ^^2^2^2911 212^^^
  13789   "^DD",200, 200.051,3, 21,1,0)
  13790   This is th e date aft er which t he persons  need for  this secur ity key sh ould
  13791   "^DD",200, 200.051,3, 21,2,0)
  13792   be reviewe d.
  13793   "^DD",200, 200.051,3, "DT")
  13794   2890929
  13795   "^DD",200, 200.052,0)
  13796   DELEGATED  KEYS SUB-F IELD^^3^4
  13797   "^DD",200, 200.052,0, "DT")
  13798   2890929
  13799   "^DD",200, 200.052,0, "IX","B",2 00.052,.01 )
  13800  
  13801   "^DD",200, 200.052,0, "NM","DELE GATED KEYS ")
  13802  
  13803   "^DD",200, 200.052,0, "UP")
  13804   200
  13805   "^DD",200, 200.052,.0 1,0)
  13806   DELEGATED  KEY^M*P19. 1'X^DIC(19 .1,^0;1^S  DIC("S")=" I DUZ(0)=" "@""!$D(^X USEC(""XUM GR"",DUZ)) !$S('$D(^V A(200,DUZ, 52,Y,0)):0 ,1:$P(^(0) ,U,4))" D  ^DIC K DIC  S DIC=DIE ,X=+Y K:Y< 0 X S:$D(X ) DINUM=X
  13807   "^DD",200, 200.052,.0 1,1,0)
  13808   ^.1
  13809   "^DD",200, 200.052,.0 1,1,1,0)
  13810   200.052^B
  13811   "^DD",200, 200.052,.0 1,1,1,1)
  13812   S ^VA(200, DA(1),52," B",$E(X,1, 30),DA)=""
  13813   "^DD",200, 200.052,.0 1,1,1,2)
  13814   K ^VA(200, DA(1),52," B",$E(X,1, 30),DA)
  13815   "^DD",200, 200.052,.0 1,1,2,0)
  13816   ^^TRIGGER^ 200.052^1
  13817   "^DD",200, 200.052,.0 1,1,2,1)
  13818   K DIV S DI V=X,D0=DA( 1),DIV(0)= D0,D1=DA,D IV(1)=D1 S  Y(1)=$S($ D(^VA(200, D0,52,D1,0 )):^(0),1: "") S X=$P (Y(1),U,2) ,X=X S DIU =X K Y S X =DIV S X=D UZ X ^DD(2 00.052,.01 ,1,2,1.4)
  13819   "^DD",200, 200.052,.0 1,1,2,1.4)
  13820   S DIH=$S($ D(^VA(200, DIV(0),52, DIV(1),0)) :^(0),1:"" ),DIV=X S  $P(^(0),U, 2)=DIV,DIH =200.052,D IG=1 D ^DI CR:$O(^DD( DIH,DIG,1, 0))>0
  13821   "^DD",200, 200.052,.0 1,1,2,2)
  13822   Q
  13823   "^DD",200, 200.052,.0 1,1,2,"%D" ,0)
  13824   ^^1^1^2890 929^
  13825   "^DD",200, 200.052,.0 1,1,2,"%D" ,1,0)
  13826   This keeps  track of  who gave t he key for  delegatio n.
  13827   "^DD",200, 200.052,.0 1,1,2,"CRE ATE VALUE" )
  13828   S X=DUZ
  13829   "^DD",200, 200.052,.0 1,1,2,"DEL ETE VALUE" )
  13830   NO EFFECT
  13831   "^DD",200, 200.052,.0 1,1,2,"DT" )
  13832   2890929
  13833   "^DD",200, 200.052,.0 1,1,2,"FIE LD")
  13834   DELEGATED  BY
  13835   "^DD",200, 200.052,.0 1,1,3,0)
  13836   ^^TRIGGER^ 200.052^2
  13837   "^DD",200, 200.052,.0 1,1,3,1)
  13838   K DIV S DI V=X,D0=DA( 1),DIV(0)= D0,D1=DA,D IV(1)=D1 S  Y(1)=$S($ D(^VA(200, D0,52,D1,0 )):^(0),1: "") S X=$P (Y(1),U,3) ,X=X S DIU =X K Y S X =DIV N %I, %H,% D NOW ^%DTC X ^D D(200.052, .01,1,3,1. 4)
  13839   "^DD",200, 200.052,.0 1,1,3,1.4)
  13840   S DIH=$S($ D(^VA(200, DIV(0),52, DIV(1),0)) :^(0),1:"" ),DIV=X S  $P(^(0),U, 3)=DIV,DIH =200.052,D IG=2 D ^DI CR:$O(^DD( DIH,DIG,1, 0))>0
  13841   "^DD",200, 200.052,.0 1,1,3,2)
  13842   Q
  13843   "^DD",200, 200.052,.0 1,1,3,"%D" ,0)
  13844   ^^1^1^2890 929^
  13845   "^DD",200, 200.052,.0 1,1,3,"%D" ,1,0)
  13846   This sets  when it wa s given.
  13847   "^DD",200, 200.052,.0 1,1,3,"CRE ATE VALUE" )
  13848   TODAY
  13849   "^DD",200, 200.052,.0 1,1,3,"DEL ETE VALUE" )
  13850   NO EFFECT
  13851   "^DD",200, 200.052,.0 1,1,3,"DT" )
  13852   2890929
  13853   "^DD",200, 200.052,.0 1,1,3,"FIE LD")
  13854   DATE DELEG ATED
  13855   "^DD",200, 200.052,.0 1,3)
  13856   These are  the keys t his person  may alloc ate.
  13857   "^DD",200, 200.052,.0 1,12.1)
  13858   S DIC("S") ="I DUZ(0) =""@""!$D( ^XUSEC(""X UMGR"",DUZ ))!$S('$D( ^VA(200,DU Z,52,Y,0)) :0,1:$P(^( 0),U,4))"
  13859   "^DD",200, 200.052,.0 1,21,0)
  13860   ^^1^1^2920 423^^^^
  13861   "^DD",200, 200.052,.0 1,21,1,0)
  13862   This is a  security k ey that th is person  my allocat e to anoth er person.
  13863   "^DD",200, 200.052,.0 1,"DT")
  13864   2920423
  13865   "^DD",200, 200.052,1, 0)
  13866   DELEGATED  BY^P200'^V A(200,^0;2 ^Q
  13867   "^DD",200, 200.052,1, 5,1,0)
  13868   200.052^.0 1^2
  13869   "^DD",200, 200.052,1, 9)
  13870   ^
  13871   "^DD",200, 200.052,1, 21,0)
  13872   ^^1^1^2911 230^^^
  13873   "^DD",200, 200.052,1, 21,1,0)
  13874   This is th e person t hat gave t he securit y key that  may be de legated.
  13875   "^DD",200, 200.052,1, "DT")
  13876   2890926
  13877   "^DD",200, 200.052,2, 0)
  13878   DATE DELEG ATED^D^^0; 3^S %DT="E X" D ^%DT  S X=Y K:Y< 1 X
  13879   "^DD",200, 200.052,2, 5,1,0)
  13880   200.052^.0 1^3
  13881   "^DD",200, 200.052,2, 9)
  13882   ^
  13883   "^DD",200, 200.052,2, 21,0)
  13884   ^^1^1^2911 230^^^
  13885   "^DD",200, 200.052,2, 21,1,0)
  13886   This is th e date tha t the secu rity key w as given t o be deleg ated.
  13887   "^DD",200, 200.052,2, "DT")
  13888   2890926
  13889   "^DD",200, 200.052,3, 0)
  13890   MAY RE-DEL EGATE^S^0: NO;1:YES;0 :no;1:yes; ^0;4^Q
  13891   "^DD",200, 200.052,3, 21,0)
  13892   ^^3^3^2911 230^^^
  13893   "^DD",200, 200.052,3, 21,1,0)
  13894   Re-delegat ion means  that the p erson has  total cont rol over t he key,
  13895   "^DD",200, 200.052,3, 21,2,0)
  13896   the person  may not o nly delega te the key  to others  but may a lso give
  13897   "^DD",200, 200.052,3, 21,3,0)
  13898   others the  authoriza tion to de legate it.
  13899   "^DD",200, 200.052,3, "DT")
  13900   2890929
  13901   "^DD",200, 200.06,0)
  13902   VISITED FR OM SUB-FIE LD^^5^6
  13903   "^DD",200, 200.06,0," DT")
  13904   3000126
  13905   "^DD",200, 200.06,0," IX","B",20 0.06,.01)
  13906  
  13907   "^DD",200, 200.06,0," NM","VISIT ED FROM")
  13908  
  13909   "^DD",200, 200.06,0," UP")
  13910   200
  13911   "^DD",200, 200.06,.01 ,0)
  13912   VISITED FR OM^F^^0;1^ K:$L(X)>30 !($L(X)<1)  X
  13913   "^DD",200, 200.06,.01 ,1,0)
  13914   ^.1
  13915   "^DD",200, 200.06,.01 ,1,1,0)
  13916   200.06^B
  13917   "^DD",200, 200.06,.01 ,1,1,1)
  13918   S ^VA(200, DA(1),8910 ,"B",$E(X, 1,30),DA)= ""
  13919   "^DD",200, 200.06,.01 ,1,1,2)
  13920   K ^VA(200, DA(1),8910 ,"B",$E(X, 1,30),DA)
  13921   "^DD",200, 200.06,.01 ,1,2,0)
  13922   200^AMPIV0 1^MUMPS
  13923   "^DD",200, 200.06,.01 ,1,2,1)
  13924   D XREF^XUM PI(DA)
  13925   "^DD",200, 200.06,.01 ,1,2,2)
  13926   D XREF^XUM PI(DA)
  13927   "^DD",200, 200.06,.01 ,1,2,"%D", 0)
  13928   ^^4^4^3100 903^
  13929   "^DD",200, 200.06,.01 ,1,2,"%D", 1,0)
  13930   This cross  reference  sets the  Requires T ransmissio n (#902) f ield if th e
  13931   "^DD",200, 200.06,.01 ,1,2,"%D", 2,0)
  13932   enumeratio n process  has begun  for this f ile.  Sett ing that f ield will
  13933   "^DD",200, 200.06,.01 ,1,2,"%D", 3,0)
  13934   result in  a VPID bei ng assigne d or an up date messa ge being s ent to the  MPI
  13935   "^DD",200, 200.06,.01 ,1,2,"%D", 4,0)
  13936   for this c hange in d ata.
  13937   "^DD",200, 200.06,.01 ,1,2,"DT")
  13938   3100805
  13939   "^DD",200, 200.06,.01 ,3)
  13940   This is th e numerica l designat ion of the  user's ho me site
  13941   "^DD",200, 200.06,.01 ,21,0)
  13942   ^^3^3^3000 208^
  13943   "^DD",200, 200.06,.01 ,21,1,0)
  13944   This field  holds the  official  Station Nu mber ID of  the remot e site tha t
  13945   "^DD",200, 200.06,.01 ,21,2,0)
  13946   did the us er authent ication. T his may be  the site  that cause d this use r to
  13947   "^DD",200, 200.06,.01 ,21,3,0)
  13948   be added t o the NPF.
  13949   "^DD",200, 200.06,.01 ,"DT")
  13950   3100805
  13951   "^DD",200, 200.06,1,0 )
  13952   SITE NAME^ F^^0;2^K:$ L(X)>30!($ L(X)<2) X
  13953   "^DD",200, 200.06,1,3 )
  13954   Please ent er the nam e of the u ser's home  site
  13955   "^DD",200, 200.06,1,2 1,0)
  13956   ^^2^2^3000 126^
  13957   "^DD",200, 200.06,1,2 1,1,0)
  13958   This field  contains  the name o f the site  where the  visitor w as
  13959   "^DD",200, 200.06,1,2 1,2,0)
  13960   authentica ted.
  13961   "^DD",200, 200.06,1," DT")
  13962   3000124
  13963   "^DD",200, 200.06,2,0 )
  13964   DUZ AT HOM E SITE^NJ1 2,0^^0;3^K :+X'=X!(X> 9999999999 99)!(X<1)! (X?.E1"."1 N.N) X
  13965   "^DD",200, 200.06,2,1 ,0)
  13966   ^.1
  13967   "^DD",200, 200.06,2,1 ,1,0)
  13968   200^AMPIV3 ^MUMPS
  13969   "^DD",200, 200.06,2,1 ,1,1)
  13970   D XREF^XUM PI(DA)
  13971   "^DD",200, 200.06,2,1 ,1,2)
  13972   D XREF^XUM PI(DA)
  13973   "^DD",200, 200.06,2,1 ,1,"%D",0)
  13974   ^^4^4^3100 903^
  13975   "^DD",200, 200.06,2,1 ,1,"%D",1, 0)
  13976   This cross  reference  sets the  Requires T ransmissio n (#902) f ield if th e
  13977   "^DD",200, 200.06,2,1 ,1,"%D",2, 0)
  13978   enumeratio n process  has begun  for this f ile.  Sett ing that f ield will
  13979   "^DD",200, 200.06,2,1 ,1,"%D",3, 0)
  13980   result in  a VPID bei ng assigne d or an up date messa ge being s ent to the  MPI
  13981   "^DD",200, 200.06,2,1 ,1,"%D",4, 0)
  13982   for this c hange in d ata.
  13983   "^DD",200, 200.06,2,1 ,1,"DT")
  13984   3100805
  13985   "^DD",200, 200.06,2,3 )
  13986   Please ent er the New  Person Fi le IEN at  the home s ite
  13987   "^DD",200, 200.06,2,2 1,0)
  13988   ^^2^2^3000 126^
  13989   "^DD",200, 200.06,2,2 1,1,0)
  13990   This field  contains  the intern al entry n umber in t he New Per son File a t
  13991   "^DD",200, 200.06,2,2 1,2,0)
  13992   the site w here this  visitor wa s authenti cated.
  13993   "^DD",200, 200.06,2," DT")
  13994   3100805
  13995   "^DD",200, 200.06,3,0 )
  13996   FIRST VISI T^D^^0;4^S  %DT="EST"  D ^%DT S  X=Y K:Y<1  X
  13997   "^DD",200, 200.06,3,3 )
  13998   Please ent er the Fil eMan date/ time of fi rst visit.
  13999   "^DD",200, 200.06,3,2 1,0)
  14000   ^^2^2^3000 126^
  14001   "^DD",200, 200.06,3,2 1,1,0)
  14002   This field  contains  the date w hen this v isitor fir st visited  from the  site
  14003   "^DD",200, 200.06,3,2 1,2,0)
  14004   recorded i n the .01  field.
  14005   "^DD",200, 200.06,3," DT")
  14006   3000126
  14007   "^DD",200, 200.06,4,0 )
  14008   LAST VISIT ED^D^^0;5^ S %DT="EST " D ^%DT S  X=Y K:Y<1  X
  14009   "^DD",200, 200.06,4,3 )
  14010   Please ent er a Filem an date fo r today.
  14011   "^DD",200, 200.06,4,2 1,0)
  14012   ^^2^2^3000 126^
  14013   "^DD",200, 200.06,4,2 1,1,0)
  14014   This field  is update d each tim e a visito r arrives  from the s ite in the  .01
  14015   "^DD",200, 200.06,4,2 1,2,0)
  14016   field.
  14017   "^DD",200, 200.06,4," DT")
  14018   3000126
  14019   "^DD",200, 200.06,5,0 )
  14020   PHONE AT S ITE^F^^0;6 ^K:$L(X)>3 3!($L(X)<3 ) X
  14021   "^DD",200, 200.06,5,3 )
  14022   Pleas ente r the comm ercial pho ne number  at home si te
  14023   "^DD",200, 200.06,5,2 1,0)
  14024   ^^2^2^3000 126^
  14025   "^DD",200, 200.06,5,2 1,1,0)
  14026   This field  may conta in a phone  number fo r the visi tor at the ir home si te.
  14027   "^DD",200, 200.06,5,2 1,2,0)
  14028   Since phon e numbers  are not al ways enter ed, this f ield may b e blank.
  14029   "^DD",200, 200.06,5," DT")
  14030   3000124
  14031   "^DD",200, 200.07,0)
  14032   USER CLASS  SUB-FIELD ^^2^2
  14033   "^DD",200, 200.07,0," DT")
  14034   3041229
  14035   "^DD",200, 200.07,0," IX","B",20 0.07,.01)
  14036  
  14037   "^DD",200, 200.07,0," NM","USER  CLASS")
  14038  
  14039   "^DD",200, 200.07,0," UP")
  14040   200
  14041   "^DD",200, 200.07,.01 ,0)
  14042   User Class ^P201'^VA( 201,^0;1^Q
  14043   "^DD",200, 200.07,.01 ,1,0)
  14044   ^.1
  14045   "^DD",200, 200.07,.01 ,1,1,0)
  14046   200.07^B
  14047   "^DD",200, 200.07,.01 ,1,1,1)
  14048   S ^VA(200, DA(1),"USC 3","B",$E( X,1,30),DA )=""
  14049   "^DD",200, 200.07,.01 ,1,1,2)
  14050   K ^VA(200, DA(1),"USC 3","B",$E( X,1,30),DA )
  14051   "^DD",200, 200.07,.01 ,"DT")
  14052   3041105
  14053   "^DD",200, 200.07,2,0 )
  14054   ISPRIMARY^ S^0:No;1:Y es;^0;2^Q
  14055   "^DD",200, 200.07,2,. 1)
  14056   Is Primary
  14057   "^DD",200, 200.07,2,2 1,0)
  14058   ^^3^3^3041 229^
  14059   "^DD",200, 200.07,2,2 1,1,0)
  14060   This field  notes if  this User  Class is t he primary  User Clas s for this  
  14061   "^DD",200, 200.07,2,2 1,2,0)
  14062   user.  If  returning  just one U ser Class  then this  is the one  to be 
  14063   "^DD",200, 200.07,2,2 1,3,0)
  14064   returned.
  14065   "^DD",200, 200.07,2," DT")
  14066   3041229
  14067   "^DD",200, 200.072,0)
  14068   CLASSIFICA TION SUB-F IELD^^.01^ 1
  14069   "^DD",200, 200.072,0, "DT")
  14070   2941104
  14071   "^DD",200, 200.072,0, "IX","ARC" ,200.072,. 01)
  14072  
  14073   "^DD",200, 200.072,0, "NM","RAD/ NUC MED CL ASSIFICATI ON")
  14074  
  14075   "^DD",200, 200.072,0, "UP")
  14076   200
  14077   "^DD",200, 200.072,.0 1,0)
  14078   RAD/NUC ME D CLASSIFI CATION^MSX ^T:technol ogist;R:re sident;S:s taff;C:cle rk;^0;1^X  ^DD(200.07 2,.01,9.2)
  14079   "^DD",200, 200.072,.0 1,1,0)
  14080   ^.1
  14081   "^DD",200, 200.072,.0 1,1,1,0)
  14082   200.072^AR C^MUMPS
  14083   "^DD",200, 200.072,.0 1,1,1,1)
  14084   S ^VA(200, "ARC",$E(X ,1,30),DA( 1),DA)=""
  14085   "^DD",200, 200.072,.0 1,1,1,2)
  14086   K ^VA(200, "ARC",$E(X ,1,30),DA( 1),DA)
  14087   "^DD",200, 200.072,.0 1,1,1,3)
  14088   DO NOT DEL ETE
  14089   "^DD",200, 200.072,.0 1,1,1,"%D" ,0)
  14090   ^^2^2^2950 111^
  14091   "^DD",200, 200.072,.0 1,1,1,"%D" ,1,0)
  14092   Used to de termine if  a person  has Radiol ogy/Nuclea r Medicine  personnel
  14093   "^DD",200, 200.072,.0 1,1,1,"%D" ,2,0)
  14094   classifica tion.
  14095   "^DD",200, 200.072,.0 1,3)
  14096   Enter a cl assificati on for thi s individu al.  This  person can not be bot h an Inter preting Re sident and  Interpret ing Staff  simultaneo usly.
  14097   "^DD",200, 200.072,.0 1,9.2)
  14098   K:($D(^VA( 200,"ARC", "R",DA(1)) )&(X="S")) !(($D(^VA( 200,"ARC", "S",DA(1)) ))&(X="R") ) X
  14099   "^DD",200, 200.072,.0 1,21,0)
  14100   ^^2^2^2971 202^^^^
  14101   "^DD",200, 200.072,.0 1,21,1,0)
  14102   Defines th e role of  this indiv idual in t he Radiolo gy/Nuclear  Medicine
  14103   "^DD",200, 200.072,.0 1,21,2,0)
  14104   world.
  14105   "^DD",200, 200.072,.0 1,23,0)
  14106   ^^3^3^2971 202^^^^
  14107   "^DD",200, 200.072,.0 1,23,1,0)
  14108        This  field is a  multiple  and the da ta type is  a set of  codes.  It
  14109   "^DD",200, 200.072,.0 1,23,2,0)
  14110   should be  noted that  an indivi dual canno t be desig nated as b oth
  14111   "^DD",200, 200.072,.0 1,23,3,0)
  14112   Interpreti ng Staff a nd Interpr eting Resi dent.
  14113   "^DD",200, 200.072,.0 1,"DT")
  14114   2941104
  14115   "^DD",200, 200.074,0)
  14116   RAD/NUC ME D LOCATION  ACCESS SU B-FIELD^^. 01^1
  14117   "^DD",200, 200.074,0, "DT")
  14118   2940105
  14119   "^DD",200, 200.074,0, "IX","B",2 00.074,.01 )
  14120  
  14121   "^DD",200, 200.074,0, "NM","RAD/ NUC MED LO CATION ACC ESS")
  14122  
  14123   "^DD",200, 200.074,0, "UP")
  14124   200
  14125   "^DD",200, 200.074,.0 1,0)
  14126   RAD/NUC ME D LOCATION  ACCESS^MP 79.1'^RA(7 9.1,^0;1^Q
  14127   "^DD",200, 200.074,.0 1,1,0)
  14128   ^.1
  14129   "^DD",200, 200.074,.0 1,1,1,0)
  14130   200.074^B
  14131   "^DD",200, 200.074,.0 1,1,1,1)
  14132   S ^VA(200, DA(1),"RAL ","B",$E(X ,1,30),DA) =""
  14133   "^DD",200, 200.074,.0 1,1,1,2)
  14134   K ^VA(200, DA(1),"RAL ","B",$E(X ,1,30),DA)
  14135   "^DD",200, 200.074,.0 1,1,1,3)
  14136   DO NOT DEL ETE
  14137   "^DD",200, 200.074,.0 1,1,1,"%D" ,0)
  14138   ^^2^2^2950 111^
  14139   "^DD",200, 200.074,.0 1,1,1,"%D" ,1,0)
  14140   Used to de termine wh ich Radiol ogy/Nuclea r Medicine  Imaging l ocations a
  14141   "^DD",200, 200.074,.0 1,1,1,"%D" ,2,0)
  14142   person may  access.
  14143   "^DD",200, 200.074,.0 1,3)
  14144   Enter an a ppropriate  Rad/Nuc M ed locatio n this use r can acce ss.
  14145   "^DD",200, 200.074,.0 1,21,0)
  14146   ^^2^2^2971 021^^^^
  14147   "^DD",200, 200.074,.0 1,21,1,0)
  14148   This field  will allo w the user  to access  all data  specific t o a partic ular
  14149   "^DD",200, 200.074,.0 1,21,2,0)
  14150   Radiology/ Nuclear Me dicine loc ation.
  14151   "^DD",200, 200.074,.0 1,"DT")
  14152   2941104
  14153   "^DD",200, 200.19,0)
  14154   DELEGATED  OPTIONS SU B-FIELD^^3 ^4
  14155   "^DD",200, 200.19,0," IX","B",20 0.19,.01)
  14156  
  14157   "^DD",200, 200.19,0," NM","DELEG ATED OPTIO NS")
  14158  
  14159   "^DD",200, 200.19,0," UP")
  14160   200
  14161   "^DD",200, 200.19,.01 ,0)
  14162   DELEGATED  OPTIONS^MP 19'X^DIC(1 9,^0;1^S D INUM=X
  14163   "^DD",200, 200.19,.01 ,1,0)
  14164   ^.1
  14165   "^DD",200, 200.19,.01 ,1,1,0)
  14166   200.19^B
  14167   "^DD",200, 200.19,.01 ,1,1,1)
  14168   S ^VA(200, DA(1),19.5 ,"B",$E(X, 1,30),DA)= ""
  14169   "^DD",200, 200.19,.01 ,1,1,2)
  14170   K ^VA(200, DA(1),19.5 ,"B",$E(X, 1,30),DA)
  14171   "^DD",200, 200.19,.01 ,1,2,0)
  14172   ^^TRIGGER^ 200.19^1
  14173   "^DD",200, 200.19,.01 ,1,2,1)
  14174   K DIV S DI V=X,D0=DA( 1),DIV(0)= D0,D1=DA,D IV(1)=D1 S  Y(1)=$S($ D(^VA(200, D0,19.5,D1 ,0)):^(0), 1:"") S X= $P(Y(1),U, 2),X=X S D IU=X K Y S  X=DIV S X =DUZ X ^DD (200.19,.0 1,1,2,1.4)
  14175   "^DD",200, 200.19,.01 ,1,2,1.4)
  14176   S DIH=$S($ D(^VA(200, DIV(0),19. 5,DIV(1),0 )):^(0),1: ""),DIV=X  S $P(^(0), U,2)=DIV,D IH=200.19, DIG=1 D ^D ICR:$O(^DD (DIH,DIG,1 ,0))>0
  14177   "^DD",200, 200.19,.01 ,1,2,2)
  14178   K DIV S DI V=X,D0=DA( 1),DIV(0)= D0,D1=DA,D IV(1)=D1 S  Y(1)=$S($ D(^VA(200, D0,19.5,D1 ,0)):^(0), 1:"") S X= $P(Y(1),U, 2),X=X S D IU=X K Y S  X="" X ^D D(200.19,. 01,1,2,2.4 )
  14179   "^DD",200, 200.19,.01 ,1,2,2.4)
  14180   S DIH=$S($ D(^VA(200, DIV(0),19. 5,DIV(1),0 )):^(0),1: ""),DIV=X  S $P(^(0), U,2)=DIV,D IH=200.19, DIG=1 D ^D ICR:$O(^DD (DIH,DIG,1 ,0))>0
  14181   "^DD",200, 200.19,.01 ,1,2,"CREA TE VALUE")
  14182   S X=DUZ
  14183   "^DD",200, 200.19,.01 ,1,2,"DELE TE VALUE")
  14184   @
  14185   "^DD",200, 200.19,.01 ,1,2,"FIEL D")
  14186   DELEGATED  BY
  14187   "^DD",200, 200.19,.01 ,1,3,0)
  14188   ^^TRIGGER^ 200.19^2
  14189   "^DD",200, 200.19,.01 ,1,3,1)
  14190   K DIV S DI V=X,D0=DA( 1),DIV(0)= D0,D1=DA,D IV(1)=D1 S  Y(1)=$S($ D(^VA(200, D0,19.5,D1 ,0)):^(0), 1:"") S X= $P(Y(1),U, 3),X=X S D IU=X K Y S  X=DIV N % I,%H,% D N OW^%DTC X  ^DD(200.19 ,.01,1,3,1 .4)
  14191   "^DD",200, 200.19,.01 ,1,3,1.4)
  14192   S DIH=$S($ D(^VA(200, DIV(0),19. 5,DIV(1),0 )):^(0),1: ""),DIV=X  S $P(^(0), U,3)=DIV,D IH=200.19, DIG=2 D ^D ICR:$O(^DD (DIH,DIG,1 ,0))>0
  14193   "^DD",200, 200.19,.01 ,1,3,2)
  14194   K DIV S DI V=X,D0=DA( 1),DIV(0)= D0,D1=DA,D IV(1)=D1 S  Y(1)=$S($ D(^VA(200, D0,19.5,D1 ,0)):^(0), 1:"") S X= $P(Y(1),U, 3),X=X S D IU=X K Y S  X="" X ^D D(200.19,. 01,1,3,2.4 )
  14195   "^DD",200, 200.19,.01 ,1,3,2.4)
  14196   S DIH=$S($ D(^VA(200, DIV(0),19. 5,DIV(1),0 )):^(0),1: ""),DIV=X  S $P(^(0), U,3)=DIV,D IH=200.19, DIG=2 D ^D ICR:$O(^DD (DIH,DIG,1 ,0))>0
  14197   "^DD",200, 200.19,.01 ,1,3,"CREA TE VALUE")
  14198   TODAY
  14199   "^DD",200, 200.19,.01 ,1,3,"DELE TE VALUE")
  14200   @
  14201   "^DD",200, 200.19,.01 ,1,3,"FIEL D")
  14202   DATE DEL
  14203   "^DD",200, 200.19,.01 ,21,0)
  14204   ^^1^1^2920 513^^
  14205   "^DD",200, 200.19,.01 ,21,1,0)
  14206   This field  identifie s which op tions this  user may  delegate t o others.
  14207   "^DD",200, 200.19,.01 ,"DT")
  14208   2890417
  14209   "^DD",200, 200.19,1,0 )
  14210   DELEGATED  BY^P200'^V A(200,^0;2 ^Q
  14211   "^DD",200, 200.19,1,5 ,1,0)
  14212   200.19^.01 ^2
  14213   "^DD",200, 200.19,1,9 )
  14214   ^
  14215   "^DD",200, 200.19,1,2 1,0)
  14216   ^^2^2^2920 513^^^
  14217   "^DD",200, 200.19,1,2 1,1,0)
  14218   This field  indicates  who grant ed authori ty for thi s user to  delegate
  14219   "^DD",200, 200.19,1,2 1,2,0)
  14220   this optio n to other s.
  14221   "^DD",200, 200.19,1," DT")
  14222   2880120
  14223   "^DD",200, 200.19,2,0 )
  14224   DATE DELEG ATED^D^^0; 3^S %DT="E " D ^%DT S  X=Y K:Y<1  X
  14225   "^DD",200, 200.19,2,5 ,1,0)
  14226   200.19^.01 ^3
  14227   "^DD",200, 200.19,2,9 )
  14228   ^
  14229   "^DD",200, 200.19,2,2 1,0)
  14230   ^^2^2^2920 513^^
  14231   "^DD",200, 200.19,2,2 1,1,0)
  14232   This field  records t he date wh en this op tion was a dded to th e list
  14233   "^DD",200, 200.19,2,2 1,2,0)
  14234   of options  this user  may deleg ate to oth ers.
  14235   "^DD",200, 200.19,2," DT")
  14236   2880120
  14237   "^DD",200, 200.19,3,0 )
  14238   EDITABLE^S ^0:N;1:Y;^ 0;4^Q
  14239   "^DD",200, 200.19,3,2 1,0)
  14240   ^^1^1^2920 513^^
  14241   "^DD",200, 200.19,3,2 1,1,0)
  14242   This field  indicates  whether t his use is  allowed t o edit thi s option.
  14243   "^DD",200, 200.19,3," DT")
  14244   2880120
  14245   "^DD",200, 200.194,0)
  14246   ALERT DATE  TIME SUB- FIELD^^1^1 1
  14247   "^DD",200, 200.194,0, "DT")
  14248   2940705
  14249   "^DD",200, 200.194,0, "NM","ALER T DATE TIM E")
  14250  
  14251   "^DD",200, 200.194,0, "UP")
  14252   200
  14253   "^DD",200, 200.194,.0 1,0)
  14254   ALERT DATE  TIME^MDX^ ^0;1^S %DT ="ESTXR" D  ^%DT S X= Y K:Y<1 X  S:$D(X) DI NUM=X
  14255   "^DD",200, 200.194,.0 1,1,0)
  14256   ^.1^^0
  14257   "^DD",200, 200.194,.0 1,21,0)
  14258   ^^1^1^2930 402^
  14259   "^DD",200, 200.194,.0 1,21,1,0)
  14260   This is th e date and  time when  the alert  was gener ated.
  14261   "^DD",200, 200.194,.0 1,"DT")
  14262   2900822
  14263   "^DD",200, 200.194,.0 2,0)
  14264   PACKAGE ID ^F^^0;2^K: X[""""!($A (X)=45) X  I $D(X) K: $L(X)>20!( $L(X)<2) X
  14265   "^DD",200, 200.194,.0 2,1,0)
  14266   ^.1
  14267   "^DD",200, 200.194,.0 2,1,1,0)
  14268   200^AXQA^M UMPS
  14269   "^DD",200, 200.194,.0 2,1,1,1)
  14270   S ^VA(200, "AXQA",$E( X,1,30),DA (1),DA)=""
  14271   "^DD",200, 200.194,.0 2,1,1,2)
  14272   K ^VA(200, "AXQA",$E( X,1,30),DA (1),DA)
  14273   "^DD",200, 200.194,.0 2,1,1,"%D" ,0)
  14274   ^^5^5^2930 402^^^
  14275   "^DD",200, 200.194,.0 2,1,1,"%D" ,1,0)
  14276    
  14277   "^DD",200, 200.194,.0 2,1,1,"%D" ,2,0)
  14278   This is a  cross-refe rence on t he complet e XQAID va lue for th is alert,
  14279   "^DD",200, 200.194,.0 2,1,1,"%D" ,3,0)
  14280   which can  be used to  identify  those indi viduals wh o received  this part icular
  14281   "^DD",200, 200.194,.0 2,1,1,"%D" ,4,0)
  14282   instance o f the aler t, and cou ld be used  to delete  other ent ries which
  14283   "^DD",200, 200.194,.0 2,1,1,"%D" ,5,0)
  14284   had receiv ed the ale rt.
  14285   "^DD",200, 200.194,.0 2,1,1,"DT" )
  14286   2910528
  14287   "^DD",200, 200.194,.0 2,1,2,0)
  14288   200^AXQAN^ MUMPS
  14289   "^DD",200, 200.194,.0 2,1,2,1)
  14290   S ^VA(200, "AXQAN",$E ($P(X,";") ,1,30),DA( 1),DA)=""
  14291   "^DD",200, 200.194,.0 2,1,2,2)
  14292   K ^VA(200, "AXQAN",$E ($P(X,";") ,1,30),DA( 1),DA)
  14293   "^DD",200, 200.194,.0 2,1,2,"%D" ,0)
  14294   ^^6^6^2930 402^^^
  14295   "^DD",200, 200.194,.0 2,1,2,"%D" ,1,0)
  14296    
  14297   "^DD",200, 200.194,.0 2,1,2,"%D" ,2,0)
  14298   This cross -reference  may be us ed to iden tify those  users who  received  the
  14299   "^DD",200, 200.194,.0 2,1,2,"%D" ,3,0)
  14300   alert with  the appli cation pac kage speci fied XQAID  (the firs t ";"-piec e
  14301   "^DD",200, 200.194,.0 2,1,2,"%D" ,4,0)
  14302   of the com plete XQAI D value) f or those c ases in wh ich the fu ll XQAID v alue
  14303   "^DD",200, 200.194,.0 2,1,2,"%D" ,5,0)
  14304   may not be  known, e. g., an app lication w hich was s elected by  the user
  14305   "^DD",200, 200.194,.0 2,1,2,"%D" ,6,0)
  14306   without se lecting th e ALERT AC TION optio n to proce ss the ale rt.
  14307   "^DD",200, 200.194,.0 2,1,2,"DT" )
  14308   2910528
  14309   "^DD",200, 200.194,.0 2,3)
  14310   Answer mus t be 2-20  characters  in length .
  14311   "^DD",200, 200.194,.0 2,21,0)
  14312   ^^4^4^2930 402^
  14313   "^DD",200, 200.194,.0 2,21,1,0)
  14314   This is a  field in w hich the p ackage id  passed dur ing alert  filing.  T his
  14315   "^DD",200, 200.194,.0 2,21,2,0)
  14316   id may sim ply be a p ackage nam espace, or  it may be  a namespa ce followe d by
  14317   "^DD",200, 200.194,.0 2,21,3,0)
  14318   additional  data to m ore accura tely ident ify the ty pe or purp ose of the
  14319   "^DD",200, 200.194,.0 2,21,4,0)
  14320   alert.
  14321   "^DD",200, 200.194,.0 2,"DT")
  14322   2910528
  14323   "^DD",200, 200.194,.0 3,0)
  14324   MESSAGE TE XT^F^^0;3^ K:$L(X)>60 !($L(X)<3)  X
  14325   "^DD",200, 200.194,.0 3,3)
  14326   Answer mus t be 3-60  characters  in length .
  14327   "^DD",200, 200.194,.0 3,21,0)
  14328   ^^4^4^2930 402^
  14329   "^DD",200, 200.194,.0 3,21,1,0)
  14330   This field  contains  the text o f the mess age to be  presented  to the use r at
  14331   "^DD",200, 200.194,.0 3,21,2,0)
  14332   the time w hen he cyc les throug h the menu  system th e first ti me after t he
  14333   "^DD",200, 200.194,.0 3,21,3,0)
  14334   alert has  been filed  for the u ser, and w hen the us er selects  the VIEW
  14335   "^DD",200, 200.194,.0 3,21,4,0)
  14336   ALERTS opt ion.
  14337   "^DD",200, 200.194,.0 3,"DT")
  14338   2900822
  14339   "^DD",200, 200.194,.0 4,0)
  14340   NEW ALERT  FLAG^S^1:N EW;^0;4^Q
  14341   "^DD",200, 200.194,.0 4,21,0)
  14342   ^^4^4^2930 402^
  14343   "^DD",200, 200.194,.0 4,21,1,0)
  14344   This flag  is used by  the alert  processin g to indic ate a new  alert whic h
  14345   "^DD",200, 200.194,.0 4,21,2,0)
  14346   has not pr eviously b een presen ted to the  user.  Af ter the al ert messag e
  14347   "^DD",200, 200.194,.0 4,21,3,0)
  14348   text has b een shown  to the use r, this fl ag is clea red and th e user mus t
  14349   "^DD",200, 200.194,.0 4,21,4,0)
  14350   then selec t the VIEW  ALERTS op tion to pr ocess the  alert.
  14351   "^DD",200, 200.194,.0 4,"DT")
  14352   2900822
  14353   "^DD",200, 200.194,.0 5,0)
  14354   ACTION FLA G^S^D:DELE TE;R:RUN R OUTINE;I:I MMEDIATE R UN;^0;5^Q
  14355   "^DD",200, 200.194,.0 5,21,0)
  14356   ^^3^3^2930 402^
  14357   "^DD",200, 200.194,.0 5,21,1,0)
  14358   This flag  is optiona l at the p resent tim e, since t he need fo r action
  14359   "^DD",200, 200.194,.0 5,21,2,0)
  14360   processing  can be de termined b y the pres ence of an  option na me or a
  14361   "^DD",200, 200.194,.0 5,21,3,0)
  14362   routine na me for use  during al ert proces sing.
  14363   "^DD",200, 200.194,.0 5,"DT")
  14364   2900822
  14365   "^DD",200, 200.194,.0 6,0)
  14366   RESERVED1^ F^^0;6^K:$ L(X)>10!($ L(X)<1) X
  14367   "^DD",200, 200.194,.0 6,3)
  14368   Answer mus t be 1-10  characters  in length .
  14369   "^DD",200, 200.194,.0 6,21,0)
  14370   ^^1^1^2930 402^
  14371   "^DD",200, 200.194,.0 6,21,1,0)
  14372   This field  is reserv ed for fut ure use by  the alert  system.
  14373   "^DD",200, 200.194,.0 6,"DT")
  14374   2910612
  14375   "^DD",200, 200.194,.0 7,0)
  14376   ENTRY POIN T^FX^^0;7^ K:$L(X)>8! ($L(X)<1)! '(X?.UN) X
  14377   "^DD",200, 200.194,.0 7,3)
  14378   Enter a va lid line t ag 1 to 8  characters
  14379   "^DD",200, 200.194,.0 7,21,0)
  14380   ^^6^6^2930 402^
  14381   "^DD",200, 200.194,.0 7,21,1,0)
  14382   While name d ENTRY PO INT, this  is a dual  function f ield.  If  the next f ield
  14383   "^DD",200, 200.194,.0 7,21,2,0)
  14384   (#.08, ARO UTINE NAME ) contains  a routine  name, thi s field co ntains the
  14385   "^DD",200, 200.194,.0 7,21,3,0)
  14386   desired en try point  within tha t routine  (this fiel d may also  be null,
  14387   "^DD",200, 200.194,.0 7,21,4,0)
  14388   indicating  that the  entry poin t should b e at the t op of the  routine).   If
  14389   "^DD",200, 200.194,.0 7,21,5,0)
  14390   field #.08  is null,  then the c ontents of  this fiel d is inter preted as  the
  14391   "^DD",200, 200.194,.0 7,21,6,0)
  14392   name of an  option wh ich is to  be entered  when the  alert is p rocessed.
  14393   "^DD",200, 200.194,.0 7,"DT")
  14394   2910613
  14395   "^DD",200, 200.194,.0 8,0)
  14396   AROUTINE N AME^F^^0;8 ^K:$L(X)>8 !($L(X)<2) !'(X?1U.UN ) X
  14397   "^DD",200, 200.194,.0 8,3)
  14398   Answer mus t be 2-8 c haracters  in length.
  14399   "^DD",200, 200.194,.0 8,21,0)
  14400   ^^10^10^29 30402^
  14401   "^DD",200, 200.194,.0 8,21,1,0)
  14402   If this fi eld is not  null, it  contains t he name of  a routine  which is  to
  14403   "^DD",200, 200.194,.0 8,21,2,0)
  14404   be used wh en the ale rt is proc essed.  If  there is  also a val ue in fiel d
  14405   "^DD",200, 200.194,.0 8,21,3,0)
  14406   #.07, that  value is  used as an  entry poi nt into th e routine  specified  in
  14407   "^DD",200, 200.194,.0 8,21,4,0)
  14408   this field .
  14409   "^DD",200, 200.194,.0 8,21,5,0)
  14410    
  14411   "^DD",200, 200.194,.0 8,21,6,0)
  14412   If this fi eld is nul l, field # .07 is int erpreted a s an optio n name whi ch
  14413   "^DD",200, 200.194,.0 8,21,7,0)
  14414   is to be u sed when t he alert i s processe d.
  14415   "^DD",200, 200.194,.0 8,21,8,0)
  14416    
  14417   "^DD",200, 200.194,.0 8,21,9,0)
  14418   If both th is field a nd field # .07 are nu ll, the al ert is pro cessed as  an
  14419   "^DD",200, 200.194,.0 8,21,10,0)
  14420   informatio n only ale rt.
  14421   "^DD",200, 200.194,.0 8,"DT")
  14422   2910612
  14423   "^DD",200, 200.194,.0 9,0)
  14424   RESERVED F IELD^F^^0; 9^K:$L(X)> 10!($L(X)< 1) X
  14425   "^DD",200, 200.194,.0 9,3)
  14426   Answer mus t be 1-10  characters  in length .
  14427   "^DD",200, 200.194,.0 9,21,0)
  14428   ^^1^1^2930 402^
  14429   "^DD",200, 200.194,.0 9,21,1,0)
  14430   This field  is reserv ed for fut ure use in  the alert  processin g system.
  14431   "^DD",200, 200.194,.0 9,"DT")
  14432   2910612
  14433   "^DD",200, 200.194,.1 ,0)
  14434   FIRST DATA  PIECE^F^^ 0;10^K:$L( X)>115!($L (X)<1) X
  14435   "^DD",200, 200.194,.1 ,3)
  14436   Answer mus t be 1-115  character s in lengt h.
  14437   "^DD",200, 200.194,.1 ,21,0)
  14438   ^^9^9^2930 402^
  14439   "^DD",200, 200.194,.1 ,21,1,0)
  14440   This field  and all f ollowing ^ -separated  fields ar e processe d as a sin gle
  14441   "^DD",200, 200.194,.1 ,21,2,0)
  14442   entity and  are retur ned in the  variable  XQADATA fo r use by t he applica tion
  14443   "^DD",200, 200.194,.1 ,21,3,0)
  14444   which gene rated the  alert.  Th e package  may pass a  series of  variables
  14445   "^DD",200, 200.194,.1 ,21,4,0)
  14446   using any  desired se parator in  the varia ble XQADAT A at the t ime the al ert
  14447   "^DD",200, 200.194,.1 ,21,5,0)
  14448   is setup.   When the  alert is p rocessed t he value o f XQADATA  is returne d to
  14449   "^DD",200, 200.194,.1 ,21,6,0)
  14450   the applic ation and  may be use d to estab lish param eters rela ted to the
  14451   "^DD",200, 200.194,.1 ,21,7,0)
  14452   alert with out requir ing intera ction or p rovision o f informat ion by the
  14453   "^DD",200, 200.194,.1 ,21,8,0)
  14454   user.  In  this way i nformation  related t o patient  entry numb er, specif ic
  14455   "^DD",200, 200.194,.1 ,21,9,0)
  14456   internal n umbers for  the desir ed data, e tc may be  stored and  returned.
  14457   "^DD",200, 200.194,.1 ,"DT")
  14458   2910612
  14459   "^DD",200, 200.194,1, 0)
  14460   DATA STRIN G^F^^1;E1, 245^K:$L(X )>245!($L( X)<1) X
  14461   "^DD",200, 200.194,1, 3)
  14462   This field  contains  the data a ssociated  with the a lert.
  14463   "^DD",200, 200.194,1, "DT")
  14464   2940705
  14465   "^DD",200, 200.196,0)
  14466   ALLOWABLE  NEW MENU P REFIX SUB- FIELD^^.01 ^1
  14467   "^DD",200, 200.196,0, "IX","B",2 00.196,.01 )
  14468  
  14469   "^DD",200, 200.196,0, "NM","ALLO WABLE NEW  MENU PREFI X")
  14470  
  14471   "^DD",200, 200.196,0, "UP")
  14472   200
  14473   "^DD",200, 200.196,.0 1,0)
  14474   ALLOWABLE  NEW MENU P REFIX^MF^^ 0;1^K:$L(X )>4!($L(X) <2)!'(X?1U 1UN.UN) X
  14475   "^DD",200, 200.196,.0 1,1,0)
  14476   ^.1
  14477   "^DD",200, 200.196,.0 1,1,1,0)
  14478   200.196^B
  14479   "^DD",200, 200.196,.0 1,1,1,1)
  14480   S ^VA(200, DA(1),19.6 ,"B",$E(X, 1,30),DA)= ""
  14481   "^DD",200, 200.196,.0 1,1,1,2)
  14482   K ^VA(200, DA(1),19.6 ,"B",$E(X, 1,30),DA)
  14483   "^DD",200, 200.196,.0 1,3)
  14484   Enter loca lly assign ed name sp ace, e.g.  AFS (prefe rred), or  a package  namespace,  e.g. LR,  to which t he user mu st add a Z , e.g. LRZ .
  14485   "^DD",200, 200.196,.0 1,21,0)
  14486   ^.001^6^6^ 3080204^^^ ^
  14487   "^DD",200, 200.196,.0 1,21,1,0)
  14488   This menu  prefix, us ed by the  delegate t o create l ocal optio ns,
  14489   "^DD",200, 200.196,.0 1,21,2,0)
  14490   can be in  one of two  forms: An  assigned  local name space begi nning
  14491   "^DD",200, 200.196,.0 1,21,3,0)
  14492   with the l etter "A",  such as A 6A (prefer red), or a  package n amespace,
  14493   "^DD",200, 200.196,.0 1,21,4,0)
  14494   such as LR  to which  the user m ust add th e letter " Z", .e.g.  LRZ,
  14495   "^DD",200, 200.196,.0 1,21,5,0)
  14496   (discourag ed) to avo id conflic t with nat ional rele ases.
  14497   "^DD",200, 200.196,.0 1,21,6,0)
  14498  
  14499   "^DD",200, 200.196,.0 1,"DT")
  14500   3080204
  14501   "^DD",200, 200.198,0)
  14502   MENU TEMPL ATE SUB-FI ELD^^1^2
  14503   "^DD",200, 200.198,0, "DT")
  14504   2891117
  14505   "^DD",200, 200.198,0, "IX","B",2 00.198,.01 )
  14506  
  14507   "^DD",200, 200.198,0, "NM","MENU  TEMPLATE" )
  14508  
  14509   "^DD",200, 200.198,0, "UP")
  14510   200
  14511   "^DD",200, 200.198,.0 1,0)
  14512   MENU TEMPL ATE^F^^0;1 ^K:$L(X)>6 !($L(X)<1)  X
  14513   "^DD",200, 200.198,.0 1,1,0)
  14514   ^.1
  14515   "^DD",200, 200.198,.0 1,1,1,0)
  14516   200.198^B
  14517   "^DD",200, 200.198,.0 1,1,1,1)
  14518   S ^VA(200, DA(1),19.8 ,"B",$E(X, 1,30),DA)= ""
  14519   "^DD",200, 200.198,.0 1,1,1,2)
  14520   K ^VA(200, DA(1),19.8 ,"B",$E(X, 1,30),DA)
  14521   "^DD",200, 200.198,.0 1,3)
  14522   Enter a un ique name  between 1  and 6 char acters in  length.
  14523   "^DD",200, 200.198,.0 1,"DT")
  14524   2891117
  14525   "^DD",200, 200.198,1, 0)
  14526   PATHWAY^20 0.1981^^1; 0
  14527   "^DD",200, 200.198,1, 21,0)
  14528   ^^2^2^2930 407^
  14529   "^DD",200, 200.198,1, 21,1,0)
  14530   This multi ple contai ns the inf ormation o n the opti on sequenc e specifie d
  14531   "^DD",200, 200.198,1, 21,2,0)
  14532   for a give n MENU TEM PLATE.
  14533   "^DD",200, 200.1981,0 )
  14534   PATHWAY SU B-FIELD^^. 01^1
  14535   "^DD",200, 200.1981,0 ,"DT")
  14536   2891117
  14537   "^DD",200, 200.1981,0 ,"NM","PAT HWAY")
  14538  
  14539   "^DD",200, 200.1981,0 ,"UP")
  14540   200.198
  14541   "^DD",200, 200.1981,. 01,0)
  14542   PATHWAY^WL ^^0;1^Q
  14543   "^DD",200, 200.1981,. 01,21,0)
  14544   ^^2^2^2930 407^
  14545   "^DD",200, 200.1981,. 01,21,1,0)
  14546   This field  contains  the inform ation on t he option  sequence s pecified f or
  14547   "^DD",200, 200.1981,. 01,21,2,0)
  14548   the menu t emplate.
  14549   "^DD",200, 200.1981,. 01,"DT")
  14550   2891117
  14551   "^DD",200, 200.541,0)
  14552   LICENSING  STATE SUB- FIELD^^2^3
  14553   "^DD",200, 200.541,0, "IX","B",2 00.541,.01 )
  14554  
  14555   "^DD",200, 200.541,0, "NM","LICE NSING STAT E")
  14556  
  14557   "^DD",200, 200.541,0, "UP")
  14558   200
  14559   "^DD",200, 200.541,.0 1,0)
  14560   LICENSING  STATE^P5'^ DIC(5,^0;1 ^Q
  14561   "^DD",200, 200.541,.0 1,1,0)
  14562   ^.1
  14563   "^DD",200, 200.541,.0 1,1,1,0)
  14564   200.541^B
  14565   "^DD",200, 200.541,.0 1,1,1,1)
  14566   S ^VA(200, DA(1),"PS1 ","B",$E(X ,1,30),DA) =""
  14567   "^DD",200, 200.541,.0 1,1,1,2)
  14568   K ^VA(200, DA(1),"PS1 ","B",$E(X ,1,30),DA)
  14569   "^DD",200, 200.541,.0 1,20,0)
  14570   ^.3LA^1^1
  14571   "^DD",200, 200.541,.0 1,20,1,0)
  14572   PS
  14573   "^DD",200, 200.541,.0 1,21,0)
  14574   ^^1^1^2930 506^
  14575   "^DD",200, 200.541,.0 1,21,1,0)
  14576   This is th e state is suing a li cense to p ractice me dicine for  a provide r.
  14577   "^DD",200, 200.541,.0 1,23,0)
  14578   ^^1^1^2921 104^
  14579   "^DD",200, 200.541,.0 1,23,1,0)
  14580   This field  is utiliz ed by the  Indian Hea lth Servic e.
  14581   "^DD",200, 200.541,.0 1,"DT")
  14582   2891022
  14583   "^DD",200, 200.541,1, 0)
  14584   LICENSE NU MBER^RF^^0 ;2^K:$L(X) >30!($L(X) <2) X
  14585   "^DD",200, 200.541,1, 3)
  14586   Enter the  provider's  state lic ense numbe r.
  14587   "^DD",200, 200.541,1, 20,0)
  14588   ^.3LA^1^1
  14589   "^DD",200, 200.541,1, 20,1,0)
  14590   PS
  14591   "^DD",200, 200.541,1, 21,0)
  14592   ^^2^2^2930 506^
  14593   "^DD",200, 200.541,1, 21,1,0)
  14594   This is th e licence  number tha t was issu ed to a pr ovider by  the sate
  14595   "^DD",200, 200.541,1, 21,2,0)
  14596   he is lice nced in.
  14597   "^DD",200, 200.541,1, 23,0)
  14598   ^^1^1^2921 104^
  14599   "^DD",200, 200.541,1, 23,1,0)
  14600   This field  utilized  by the Ind ian Health  Service
  14601   "^DD",200, 200.541,1, "DT")
  14602   2891022
  14603   "^DD",200, 200.541,2, 0)
  14604   EXPIRATION  DATE^RD^^ 0;3^S %DT= "EX" D ^%D T S X=Y K: Y<1 X
  14605   "^DD",200, 200.541,2, 3)
  14606   Enter the  date upon  which this  state lic ense will  expire.
  14607   "^DD",200, 200.541,2, 20,0)
  14608   ^.3LA^1^1
  14609   "^DD",200, 200.541,2, 20,1,0)
  14610   PS
  14611   "^DD",200, 200.541,2, 21,0)
  14612   ^^1^1^2930 506^
  14613   "^DD",200, 200.541,2, 21,1,0)
  14614   This is th e expirati on date of  the provi der's lice nce issued  by the st ate.
  14615   "^DD",200, 200.541,2, 21,2,0)
  14616   by the sta te.
  14617   "^DD",200, 200.541,2, 23,0)
  14618   ^^1^1^2921 104^
  14619   "^DD",200, 200.541,2, 23,1,0)
  14620   This field  is utiliz ed by the  Indian Hea lth Servic e
  14621   "^DD",200, 200.541,2, "DT")
  14622   2891022
  14623   "^DD",200, 200.55,0)
  14624   STATE ISSU ING DEA NU MBER SUB-F IELD^^1^2
  14625   "^DD",200, 200.55,0," IX","B",20 0.55,.01)
  14626  
  14627   "^DD",200, 200.55,0," NM","STATE  ISSUING D EA NUMBER" )
  14628  
  14629   "^DD",200, 200.55,0," UP")
  14630   200
  14631   "^DD",200, 200.55,.01 ,0)
  14632   STATE ISSU ING DEA NU MBER^MP5'^ DIC(5,^0;1 ^Q
  14633   "^DD",200, 200.55,.01 ,1,0)
  14634   ^.1
  14635   "^DD",200, 200.55,.01 ,1,1,0)
  14636   200.55^B
  14637   "^DD",200, 200.55,.01 ,1,1,1)
  14638   S ^VA(200, DA(1),"PS2 ","B",$E(X ,1,30),DA) =""
  14639   "^DD",200, 200.55,.01 ,1,1,2)
  14640   K ^VA(200, DA(1),"PS2 ","B",$E(X ,1,30),DA)
  14641   "^DD",200, 200.55,.01 ,3)
  14642   Enter the  state whic h has issu ed its DEA  number.
  14643   "^DD",200, 200.55,.01 ,20,0)
  14644   ^.3LA^1^1
  14645   "^DD",200, 200.55,.01 ,20,1,0)
  14646   PS
  14647   "^DD",200, 200.55,.01 ,21,0)
  14648   ^^2^2^2921 104^
  14649   "^DD",200, 200.55,.01 ,21,1,0)
  14650   This is th e state wh ich has is sued a Sta te DEA# to  a provide r.  Not al l
  14651   "^DD",200, 200.55,.01 ,21,2,0)
  14652   states req uire a sep erate DEA  #
  14653   "^DD",200, 200.55,.01 ,23,0)
  14654   ^^1^1^2921 104^
  14655   "^DD",200, 200.55,.01 ,23,1,0)
  14656   This field  is utiliz ed by the  Indian Hea lth Servic e
  14657   "^DD",200, 200.55,.01 ,"DT")
  14658   2891022
  14659   "^DD",200, 200.55,1,0 )
  14660   STATE DEA  NUMBER^RF^ ^0;2^K:$L( X)>20!($L( X)<3) X
  14661   "^DD",200, 200.55,1,3 )
  14662   Enter the  DEA number  issued by  this stat e.
  14663   "^DD",200, 200.55,1,2 0,0)
  14664   ^.3LA^1^1
  14665   "^DD",200, 200.55,1,2 0,1,0)
  14666   PS
  14667   "^DD",200, 200.55,1,2 1,0)
  14668   ^^3^3^2921 104^
  14669   "^DD",200, 200.55,1,2 1,1,0)
  14670   This is th e DEA # is sued by an  individua l state, i t is not r equired
  14671   "^DD",200, 200.55,1,2 1,2,0)
  14672   by all sta tes and in  some case s may be t he same as  the Feder al
  14673   "^DD",200, 200.55,1,2 1,3,0)
  14674   DEA #.
  14675   "^DD",200, 200.55,1,2 3,0)
  14676   ^^1^1^2921 104^
  14677   "^DD",200, 200.55,1,2 3,1,0)
  14678   This field  is utiliz ed by the  Indian Hea lth Servic e.
  14679   "^DD",200, 200.55,1," DT")
  14680   2891022
  14681   "^DD",200, 200.72,0)
  14682   DMMS UNITS  SUB-FIELD ^^.01^1
  14683   "^DD",200, 200.72,0," DT")
  14684   2930408
  14685   "^DD",200, 200.72,0," IX","B",20 0.72,.01)
  14686  
  14687   "^DD",200, 200.72,0," NM","DMMS  UNITS")
  14688  
  14689   "^DD",200, 200.72,0," UP")
  14690   200
  14691   "^DD",200, 200.72,.01 ,0)
  14692   DMMS UNITS ^MP724'^EC D(^0;1^Q
  14693   "^DD",200, 200.72,.01 ,1,0)
  14694   ^.1
  14695   "^DD",200, 200.72,.01 ,1,1,0)
  14696   200.72^B
  14697   "^DD",200, 200.72,.01 ,1,1,1)
  14698   S ^VA(200, DA(1),"EC" ,"B",$E(X, 1,30),DA)= ""
  14699   "^DD",200, 200.72,.01 ,1,1,2)
  14700   K ^VA(200, DA(1),"EC" ,"B",$E(X, 1,30),DA)
  14701   "^DD",200, 200.72,.01 ,8.5)
  14702   ^
  14703   "^DD",200, 200.72,.01 ,9)
  14704   ^
  14705   "^DD",200, 200.72,.01 ,21,0)
  14706   ^^3^3^2930 408^
  14707   "^DD",200, 200.72,.01 ,21,1,0)
  14708   The DMMS u nit to whi ch this pe rson has a ccess for  entering d ata and
  14709   "^DD",200, 200.72,.01 ,21,2,0)
  14710   generating  reports.
  14711   "^DD",200, 200.72,.01 ,21,3,0)
  14712    
  14713   "^DD",200, 200.72,.01 ,23,0)
  14714   ^^2^2^2930 408^
  14715   "^DD",200, 200.72,.01 ,23,1,0)
  14716   Pointer to  file 724.   Entries  into this  field shou ld be made  only
  14717   "^DD",200, 200.72,.01 ,23,2,0)
  14718   through th e package  and not di rectly thr ough VA Fi leMan.
  14719   "^DD",200, 200.72,.01 ,"DT")
  14720   2930408
  14721   "^DIC",200 ,200,0)
  14722   NEW PERSON ^200I
  14723   "^DIC",200 ,200,0,"GL ")
  14724   ^VA(200,
  14725   "^DIC",200 ,200,"%",0 )
  14726   ^1.005^3^3
  14727   "^DIC",200 ,200,"%",1 ,0)
  14728   QAM
  14729   "^DIC",200 ,200,"%",2 ,0)
  14730   QAP
  14731   "^DIC",200 ,200,"%",3 ,0)
  14732   LR
  14733   "^DIC",200 ,200,"%"," B","LR",1)
  14734  
  14735   "^DIC",200 ,200,"%"," B","LR",3)
  14736  
  14737   "^DIC",200 ,200,"%"," B","QAM",1 )
  14738  
  14739   "^DIC",200 ,200,"%"," B","QAP",2 )
  14740  
  14741   "^DIC",200 ,200,"%D", 0)
  14742   ^1.001^18^ 18^3090514 ^^^^
  14743   "^DIC",200 ,200,"%D", 0,"LE")
  14744   1
  14745   "^DIC",200 ,200,"%D", 1,0)
  14746   This file  contains d ata on emp loyees, us ers, pract itioners,  etc.
  14747   "^DIC",200 ,200,"%D", 2,0)
  14748   who were p reviously  in Files 3 ,6,16 and  others.
  14749   "^DIC",200 ,200,"%D", 3,0)
  14750    
  14751   "^DIC",200 ,200,"%D", 4,0)
  14752   DHCP packa ges must c heck with  the KERNEL  developer s to see t hat
  14753   "^DIC",200 ,200,"%D", 5,0)
  14754   a given nu mber/names pace is cl ear for th em to use.
  14755   "^DIC",200 ,200,"%D", 6,0)
  14756    
  14757   "^DIC",200 ,200,"%D", 7,0)
  14758   Field numb ers 53-59. 9 reserved  for Pharm .
  14759   "^DIC",200 ,200,"%D", 8,0)
  14760    Nodes and  X-ref 'PS *'.
  14761   "^DIC",200 ,200,"%D", 9,0)
  14762   Field numb ers 70-79. 9 reserved  for Radio logy
  14763   "^DIC",200 ,200,"%D", 10,0)
  14764    Nodes and  X-ref 'RA *'.
  14765   "^DIC",200 ,200,"%D", 11,0)
  14766   Field numb ers 720-72 5 reserved  for DSSM
  14767   "^DIC",200 ,200,"%D", 12,0)
  14768    Nodes and  X-ref 'EC *' and 'AE C*'.
  14769   "^DIC",200 ,200,"%D", 13,0)
  14770   Field numb ers 740-74 9.9 reserv ed for QA
  14771   "^DIC",200 ,200,"%D", 14,0)
  14772    Nodes and  X-ref 'QA *'.
  14773   "^DIC",200 ,200,"%D", 15,0)
  14774   Field numb ers 654-65 4.9 reserv ed for Soc ial work
  14775   "^DIC",200 ,200,"%D", 16,0)
  14776    Node 654  and X-ref  'SW*'.
  14777   "^DIC",200 ,200,"%D", 17,0)
  14778   Field numb ers 500-50 0.9 reserv ed for mai lman
  14779   "^DIC",200 ,200,"%D", 18,0)
  14780    Node 500  and X-ref  'XM*' and  'AXM*'.
  14781   "^DIC",200 ,200,"%D", 19,0)
  14782   Field numb ers 740-74 9.9 reserv ed for QA
  14783   "^DIC",200 ,200,"%D", 20,0)
  14784    Nodes and  X-ref 'QA *'.
  14785   "^DIC",200 ,200,"%D", 21,0)
  14786   Field numb ers 910-91 0.9 reserv ed for Pol ice Packag e
  14787   "^DIC",200 ,200,"%D", 22,0)
  14788    Node and  X-ref 'ESP '
  14789   "^DIC",200 ,"B","NEW  PERSON",20 0)
  14790  
  14791   "BLD",1045 9,6)
  14792   2^
  14793   **END**
  14794   **END**
  14795  
  14796