3. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 8/15/2018 12:48:13 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.

3.1 Files compared

# Location File Last Modified
1 EPIP_Combined_CiF.zip\EPIP_Combined_CiF\111 PSB 3.0 111 - Routine PSBMD.txt Tue Aug 14 13:18:38 2018 UTC
2 EPIP_Combined_CiF.zip\EPIP_Combined_CiF\111 PSB 3.0 111 - Routine PSBMD.txt Tue Aug 14 14:49:33 2018 UTC

3.2 Comparison summary

Description Between
Files 1 and 2
Text Blocks Lines
Unchanged 2 694
Changed 1 2
Inserted 0 0
Removed 0 0

3.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

3.4 Active regular expressions

No regular expressions were active.

3.5 Comparison detail

  1   PSBMD * *   321 LINES ,  (total  13835, com ments 2534 ) BYTES    Page 1
  2           RS UM: old 26 060112, ne w 15118709 4
  3             UCI: VISTA ,ROU      Site: TEST .CHEYENNE URL          JUL 31,201 8@07:44
  4  
  5     1 PSBMD   ;BIRMINGH AM/EFC - B CMA MISSIN G DOSE FUN CTIONS ; 9 /26/17 3:2 5pm
  6     2         ;;3.0;BAR  CODE MED  ADMIN;**23 ,42,70,100 ,111**;Mar  2004;Buil d 101
  7     3         ;
  8     4         ; Referen ce/IA
  9     5         ; ^DIC(42 /10039
  10     6         ; ^DPT(/1 0035
  11     7         ; IN5^VAD PT/10061
  12     8         ; DEM^VAD PT/10061
  13     9         ; ^XMB/10 070
  14    10         ; 52.6/43 6
  15    11         ; 52.7/43 7
  16    12         ; ^DG(40. 8/417
  17    13         ; 4/2171
  18    14         ; ^DG(40. 8/2817
  19    15         ; ^VA(200 /10060
  20    16         ; ^DIC(4/ 10090
  21    17         ; ^DG(43/ 6812
  22    18         ;
  23    19         ;*70 -  a dd new ker nel variab le for CO  Missing Do se Printer .
  24    20         ;       u se Clinc n ame if pas sed in for  the new f ield Clini c or
  25    21         ;         assume War d and get  ien.
  26    22         ;
  27    23 RPC(RE SULTS,PSBD FN,PSBDRUG ,PSBDOSE,P SBRSN,PSBA DMIN,PSBNE ED,PSBUID, PSBON,PSBS CHD,PSBCLI N,PSBCLNIE N) --
  28                ;
  29    24         ;
  30    25         ; RPC: PS B SUBMIT M ISSING DOS E
  31    26         ;
  32    27         ; Descrip tion:
  33    28         ; Allows  the client  to submit  a missing  dose inte ractively
  34    29         ;
  35    30         N DFN,PSB NOW,PSBFDA ,PSBIENS,P SBMD,PSBMS G
  36    31         S PSBCLNI EN=+$G(PSB CLNIEN)     ;*70 insu re numeric
  37    32         D NEW(.PS BMD)
  38    33         I +PSBMD( 0)<1 S RES ULTS(0)="- 1^Unable t o create m issing dos e request"   Q
  39    34         S PSBIENS =+PSBMD(0) _","
  40    35         D NOW^%DT C S PSBNOW =%
  41    36         S PSBFDA( 53.68,PSBI ENS,.02)=P SBNOW
  42    37         S PSBFDA( 53.68,PSBI ENS,.03)=D UZ
  43    38         S PSBFDA( 53.68,PSBI ENS,.04)=D UZ(2)
  44    39         S PSBFDA( 53.68,PSBI ENS,.11)=P SBDFN
  45    40         ; Ward or  Clinic -  use Clinic  name if p assed, els e get Ward  ien.  *70
  46    41         I PSBCLIN ]"" D
  47    42         .S PSBFDA (53.68,PSB IENS,1)=PS BCLNIEN
  48    43         E  D
  49    44         .S X=$G(^ DPT(PSBDFN ,.1))
  50    45         .I X]"" S  X=$O(^DIC (42,"B",X, 0)) S:X PS BFDA(53.68 ,PSBIENS,. 12)=X
  51    46         .S DFN=PS BDFN D IN5 ^VADPT S P SBFDA(53.6 8,PSBIENS, .18)=$P(VA IP(6),U,1)
  52    47         S PSBFDA( 53.68,PSBI ENS,.13)=P SBDRUG
  53    48         S PSBFDA( 53.68,PSBI ENS,.14)=P SBDOSE
  54    49         S PSBFDA( 53.68,PSBI ENS,.15)=P SBRSN
  55    50         S PSBFDA( 53.68,PSBI ENS,.16)=P SBADMIN
  56    51         S PSBFDA( 53.68,PSBI ENS,.17)=P SBNEED
  57    52         S PSBFDA( 53.68,PSBI ENS,.19)=P SBSCHD
  58    53         S PSBFDA( 53.68,PSBI ENS,.25)=P SBUID
  59    54         D FILE^DI E("","PSBF DA","PSBMS G")
  60    55         L +^PSB(5 3.68,+PSBI ENS):$S($G (DILOCKTM) >0:DILOCKT M,1:3)  ;  PSB*3*23
  61    56         I $G(PSBU ID)'="" D
  62    57         .D PSJ1^P SBVT(PSBDF N,PSBON) K  PSBADA,PS BSOLA
  63    58         .I '$D(PS BUIDA(PSBU ID)) F  D  PSJ1^PSBVT (PSBDFN,PS BPONX) K P SBADA,PSBS OLA Q:$D(P SBUIDA(PSB UID))  Q:P SBPONX=""
  64    59         .F I=1:1  S PSBAD=$P (PSBUIDA(P SBUID),U,I ) Q:PSBAD= ""  I PSBA D["ADD" S  PSBADA($P( PSBAD,";", 2))=""
  65    60         .I $D(PSB ADA) S X=" " F I=1:1  S X=$O(PSB ADA(X)) Q: X=""  S PS BFDA(53.68 6,I_","_PS BIENS,.01) =X,^PSB(53 .68,+PSBIE NS,.
  66                6,I,0)=I
  67    61         .F I=1:1  S PSBSOL=$ P(PSBUIDA( PSBUID),U, I) Q:PSBSO L=""  I PS BSOL["SOL"  S PSBSOLA ($P(PSBSOL ,";",2))=" "
  68    62         .I $D(PSB SOLA) S X= "" F I=1:1  S X=$O(PS BSOLA(X))  Q:X=""  S  PSBFDA(53. 687,I_","_ PSBIENS,.0 1)=X,^PSB( 53.68,+PSB IENS
  69                ,.7,I,0) =I
  70    63         I $G(PSBU ID)="",$G( PSBDRUG)=" " D
  71    64         .D PSJ1^P SBVT(PSBDF N,PSBON)
  72    65         .I $D(PSB ADA) S X=" " F I=1:1  S X=$O(PSB ADA(X)) Q: X=""  S PS BFDA(53.68 6,I_","_PS BIENS,.01) =$P(PSBADA (X),U,2),^ PSB(
  73                53.68,+P SBIENS,.6, I,0)=X
  74    66         .I $D(PSB SOLA) S X= "" F I=1:1  S X=$O(PS BSOLA(X))  Q:X=""  S  PSBFDA(53. 687,I_","_ PSBIENS,.0 1)=$P(PSBS OLA(X),U,2 ),^P
  75                SB(53.68 ,+PSBIENS, .7,I,0)=X
  76    67         D FILE^DI E("","PSBF DA","PSBMS G")
  77    68         L -^PSB(5 3.68,+PSBI ENS) ; PSB 83*23
  78    69         D SUBMIT( +PSBIENS)
  79    70         S RESULTS (0)="1^Mis sing Dose  Submitted^ "_+PSBIENS
  80    71         D CLEAN^P SBVT
  81    72         Q
  82    73         ;
  83    74 XQ      ; Called  via Kernel  Menus
  84    75         N PSBMD,P SBSAVE,DA, DIK,DR,DDS FILE,XMY,X MTEXT,XMSU B
  85    76         D NEW(.PS BMD)
  86    77         I +PSBMD( 0)<1 W !," Error: ",$ P(PSBMD(0) ,U,2) S DI R(0)="E" D  ^DIR Q
  87    78         S DA=+PSB MD(0),DR=" [PSB MISSI NG DOSE RE QUEST]",DD SFILE=53.6 8 D ^DDS
  88    79         W @IOF
  89    80         I 'PSBSAV E W !,"Can celling Re quest..."  S DIK="^PS B(53.68,"  D ^DIK W " Cancelled! "
  90    81         D:PSBSAVE  SUBMIT(DA )
  91    82         Q
  92    83         ;
  93    84 SUBMIT (DA) --
  94                ; Submit  Request t o Pharmacy
  95    85         N PSBWRD, PSBMG,PSBP RT,CLIEN
  96    86         S PSBWRD= $P(^PSB(53 .68,DA,.1) ,U,2)
  97    87         S PSBWRD= +$G(^DIC(4 2,+PSBWRD, 44))
  98    88         I PSBCLIN ]"" S CLIE N=+$O(^PS( 53.46,"B", PSBCLNIEN, ""))
  99    89         ;
  100    90         ; Get Mai l Group
  101    91         ;
  102    92         S PSBMG=$ $GET^XPAR( PSBWRD_";S C(","PSB M G MISSING  DOSE",,"E" )
  103    93         S:PSBMG=" " PSBMG=$$ GET^XPAR(" DIV","PSB  MG MISSING  DOSE",,"E ")
  104    94         S $P(^PSB (53.68,DA, 0),U,5)=PS BMG ; Add  MG to noti fication
  105    95         ;
  106    96         ; Get Pri nter - If  NO printer  can be fo und, then  DO NOT pri nt!!
  107    97         ;*70 - ge t CO print er if Clin ic orders,  else IM m ed & get I M printer
  108    98         ; IM prin ter uses V ariable PS B PRINTER  MISSING DO SE
  109    99         ; CO prin ter can co me from 3  sources:
  110   100         ;  1st fr om Clinic  Defintion  file for t he specifi c Clinic i f defined
  111   101         ;  2nd fr om the Var iable PSB  PRINTER CO  MISSING D OSE if def ined
  112   102         ;  3rd ju st use the  IM med pr inter Vari able.
  113   103         ;
  114   104         D:PSBCLIN ]""                                                 ;* 70
  115   105         .S PSBPRT =$$GET1^DI Q(53.46,CL IEN,4)
  116   106         .S:PSBPRT ="" PSBPRT =$$GET^XPA R("DIV","P SB PRINTER  CO MISSIN G DOSE",," E")
  117   107         .S:PSBPRT ="" PSBPRT =$$GET^XPA R("DIV","P SB PRINTER  MISSING D OSE",,"E")
  118   108         D:PSBCLIN =""                                                 ;* 70
  119   109         .S PSBPRT =$$GET^XPA R(PSBWRD_" ;SC(","PSB  PRINTER M ISSING DOS E",,"E")
  120   110         .S:PSBPRT ="" PSBPRT =$$GET^XPA R("DIV","P SB PRINTER  MISSING D OSE",,"E")
  121   111         ;
  122   112         S $P(^PSB (53.68,DA, 0),U,6)=PS BPRT ; Add  MG to not ification
  123   113         ;
  124   114         ; Send th e report t o the spec ified prin ter
  125   115         ;
  126   116         D:PSBPRT] ""
  127   117         .W !,"Sub mitting Re quest To P harmacy on  device ", PSBPRT,".. ."
  128   118         .D NOW^%D TC
  129   119         .S ZTIO=P SBPRT
  130   120         .S ZTDTH= %
  131   121         .S ZTDESC ="BCMA - M ISSING DOS E REQUEST"
  132   122         .S ZTRTN= "DQ^PSBMD( "_DA_")"
  133   123         .D ^%ZTLO AD
  134   124         .W "Done! "
  135   125         ;
  136   126         ; Send th e same stu ff to the  mail group
  137   127         ;
  138   128         D:PSBMG]" "
  139   129         .W !,"Not ifying Pha rmacy via  Mail Group  ",PSBMG," ..."
  140   130         .D HFSOPE N^PSBUTL(" MISSING DO SE")
  141   131         .U IO D D Q(DA,1)
  142   132         .D HFSCLO SE^PSBUTL( "MISSING D OSE")
  143   133         .S XMY("G ."_PSBMG)= "",XMTEXT= "^TMP(""PS BO"",$J,"
  144   134         .S XMSUB= "BCMA - Mi ssing Dose  Request"
  145   135         .D ^XMD
  146   136         .W "Done! "
  147   137         Q
  148   138         ;
  149   139 DQ(PSB MD,PSBMM)  --
  150                ; Dequeu e report f rom Taskma n
  151   140         N PSBFLD, PSBRET
  152   141         Q:'$D(^PS B(53.68,PS BMD,0))
  153   142         L +^PSB(5 3.68,PSBMD ):$S($G(DI LOCKTM)>0: DILOCKTM,1 :3) ; PSB* 3*23
  154   143         S PSBCFLD =$P(^PSB(5 3.68,PSBMD ,.1),U,3)
  155   144         L -^PSB(5 3.68,PSBMD ) ; PSB*3* 23
  156   145         D:'$G(PSB MM)  ; It  is not a m ail messag e
  157   146         .W !,$TR( $J("",75), " ","=")
  158   147         .W !,"Rep ort:        MISSING D OSE REQUES T"
  159   148         .W !,"Dat e Created:  " D NOW^% DTC S Y=%  D D^DIQ W  Y
  160   149         .W !,$TR( $J("",75), " ","="),!
  161   150         I $G(PSBC FLD)'="" F  PSBFLD=.0 1,.02,.03, .04,.05,.0 6,.11,.12, .18,1,.13, .14,.19,.1 5,.16,.17  D OUT  ;*7 0
  162   151         I $G(PSBC FLD)="" F  PSBFLD=.01 ,.02,.03,. 04,.05,.06 ,.11,.12,. 18,1,.25,. 15,.19,.16 ,.17 D OUT   ;*70
  163   152         I $D(^PSB (53.68,PSB MD,.6)) S  X=0 F  S X =$O(^PSB(5 3.68,PSBMD ,.6,X)) Q: 'X  W !?3, "ADDITIVE:   ",$$GET1 ^DIQ(52.6, +^PS
  164                B(53.68, PSBMD,.6,X ,0),.01)
  165   153         I $D(^PSB (53.68,PSB MD,.7)) S  X=0 F  S X =$O(^PSB(5 3.68,PSBMD ,.7,X)) Q: 'X  W !?3, "SOLUTION:   ",$$GET1 ^DIQ(52.7, +^PS
  166                B(53.68, PSBMD,.7,X ,0),.01)
  167   154         Q
  168   155 OUT     ;
  169   156         D FIELD^D ID(53.68,P SBFLD,""," LABEL","PS BRET")
  170   157         W !?3,PSB RET("LABEL "),":" F   Q:$X>30  W  "."
  171   158         W $$GET1^ DIQ(53.68, PSBMD_",", PSBFLD)
  172   159         I PSBFLD= .11 D
  173   160         .N DFN,VA ,VADM S DF N=$$GET1^D IQ(53.68,P SBMD_",",. 11,"I") D  DEM^VADPT
  174   161         .W !?3,$$ GET^XPAR(" ALL","PSB  PATIENT ID  LABEL")
  175   162         .I $G(DUZ ("AG"))="I " D
  176   163         ..W ":" F   Q:$X>30   W "."
  177   164         .E  D
  178   165         ..W " (LA ST 4 NUMBE RS):" F  Q :$X>30  W  "."
  179   166         .W VA("BI D")
  180   167         W:PSBFLD= .13 " ("_$ P($G(^PSB( 53.68,PSBM D,.1)),U,3 )_")"
  181   168         S ZTREQ=" @"
  182   169         Q
  183   170         ;
  184   171 NEW(RE SULTS) --
  185                ; Create  a new mis sing dose  request
  186   172         ; Called  interactiv ely and vi a RPCBroke r
  187   173         N DIC
  188   174         K RESULTS
  189   175         I '+$G(DU Z) S RESUL TS(0)="-1^ Undefined  User" Q
  190   176         I '$G(DUZ (2)) S RES ULTS(0)="- 1^Undefine d Division " Q
  191   177         ; Lock Lo g
  192   178         L +^PSB(5 3.68,0):$S ($G(DILOCK TM)>0:DILO CKTM,1:3)
  193   179         E  S RESU LTS(0)="-1 ^Request L og Locked"  Q
  194   180         ; Generat e Unique E ntry and C reate
  195   181         F  D NOW^ %DTC S X=$ E(%_"00000 0",1,14),X =(1700+$E( X,1,3))_$E (X,4,14),X ="MD-"_$TR (X,".","-" ) Q:'$D(^P SB(53.68," B",X
  196                ))
  197   182         S DIC="^P SB(53.68," ,DIC(0)="L "
  198   183         S DIC("DR ")=".02/// N;.03////^ S X=DUZ;.0 4////^S X= DUZ(2);.07 ///1"
  199   184         K D0          ;VRN
  200   185         D FILE^DI CN
  201   186         L -^PSB(5 3.68,0)
  202   187         ; Okay, s etup retur n and Boog ie
  203   188         I +Y<1 S  RESULTS(0) ="-1^Error  Creating  Request"
  204   189         E  S RESU LTS(0)=Y
  205   190         Q
  206   191         ;
  207   192 VAL(PS BFLDS) --
  208                ; Valida te that fi elds in PS BFLDS are  filled in
  209   193         N PSB,PSB FLD,PSBMSG
  210   194         F PSB=1:1  Q:$P(PSBF LDS,";",PS B)=""  S P SBFLD=$P(P SBFLDS,";" ,PSB),PSBF LD(PSBFLD) =$$GET^DDS VAL(53.68, DA,PSBFLD)
  211   195         I $D(PSBF LD(.21)) K :PSBFLD(.2 1)="N" PSB FLD(.22),P SBFLD(.23)
  212   196         S PSB=""   F  S PSB= $O(PSBFLD( PSB)) Q:PS B=""  D:PS BFLD(PSB)= ""
  213   197         .I '$D(PS BMSG) S PS BMSG(0)="U NABLE TO F ILE REQUES T",PSBMSG( 1)=" ",PSB MSG(2)="ER ROR: MISSI NG DATA -  ALL FIELDS  ARE
  214                 REQUIRE D"
  215   198         .D FIELD^ DID(53.68, PSB,"","TI TLE;LABEL" ,"PSB")
  216   199         .S X="  M issing Fie ld: "_$S(P SB("TITLE" )]"":PSB(" TITLE"),1: PSB("LABEL ")),PSBMSG ($O(PSBMSG (""),-1)+1 )=X
  217   200         Q:'$D(PSB MSG)  ; Al l is well
  218   201         D MSG^DDS UTL(.PSBMS G)
  219   202         S DDSERRO R=1
  220   203         Q
  221   204         ;
  222   205 CHK1    ; Start P SB*3*100 c hanges: us e 'DIVAS'  cross ref  for multid ivision si tes
  223   206         ; DUZ(2),  the user' s division , is set a t sign-on.  At multid ivision si tes where  a user has  access
  224   207         ; to mult iple divis ions, allo w selectio n of a div ision from  the divis ions defin ed in file  #40.8.
  225   208         ; The use r must hav e at least  one divis ion from f ile #40.8  in his fil e #200 rec ord.
  226   209         K ^TMP("P SBMD",$J)
  227   210         N DIR
  228   211         W !
  229   212         S DIR(0)= "SB^A:All  Divisions; O:One Divi sion"
  230   213         S DIR("?" )="Select  either All  Divisions  or One Di vision."
  231   214         S DIR("A" )="Do you  want (A)ll  Divisions  or just ( O)ne Divis ion"
  232   215         S DIR("B" )="O"
  233   216         D ^DIR K  DIR I $D(D UOUT)!$D(D TOUT)!$D(D IROUT)!$D( DIRUT) Q
  234   217         I Y="" Q
  235   218         I Y(0)="O ne Divisio n" D ONE Q    ; regar dless user  divisions  in file # 200
  236   219         I Y(0)="A ll Divisio ns" D ALL  Q
  237   220         Q
  238   221         ;
  239   222 ALL     ; user ge ts all div isions (cu rrent beha vior); app licable to  single di vision sit es as well
  240   223         S Y(0)="A ll Divisio ns"
  241   224         S PSBDIV= DUZ(2)
  242   225         S PSBSTIE N=+$O(^DG( 40.8,"AD", DUZ(2),"") ) ; curren t IEN for  station
  243   226         S Y=$$GET 1^DIQ(40.8 ,PSBSTIEN, .01,"E")
  244   227         I '$D(Y)  S Y=DUZ(2)
  245   228         S PSBNAME =$$NAME^XU AF4(DUZ(2) )
  246   229         S PSBMUDV =0
  247   230         S ^TMP("P SBMD",$J)= PSBMUDV_U_ PSBDIV_U_P SBNAME
  248   231         Q
  249   232         ;
  250   233 ONE     ; when us er selects  one divis ion from m any in fil e #200, lo ok at file  #40.8 for  a match i f availabl e
  251   234         W !
  252   235         S PSBSTIE N=+$O(^DG( 40.8,"AD", DUZ(2),"") ) ; curren t IEN for  station
  253   236         S PSBDVNM =$$GET1^DI Q(40.8,PSB STIEN,.01, "I") ;divi sion name
  254   237         S DIC("B" )=PSBDVNM
  255   238         S DIC("A" )="Select  Division:  ",DIC="^DG (40.8,",DI C(0)="AEMQ ",DIC("S") ="I $$SITE ^VASITE(,+ Y)>0"
  256   239         D ^DIC
  257   240         ; capture  the divis ion name a nd number  after user  selection
  258   241         S PSBNAME =$$GET1^DI Q(40.8,+Y, .01,"E")
  259   242         S PSBDPTR =$$GET1^DI Q(40.8,+Y, .07,"I") ;  pointer t o file #4
  260   243         S PSBDIV= PSBDPTR
  261   244         S ^TMP("P SBMD",$J)= PSBMUDV_U_ PSBDIV_U_P SBNAME
  262   245         Q
  263   246         ;end of c hanges for  PSB*3*100
  264   247         ;
  265   248 FLWUP   ; Follow- Up on miss ing dose
  266   249         ; start P SB*3*100 c hanges
  267   250         N D0,DIC, PSBDATA,PS BDPTR,PSBD IV,PSBDVNM ,PSBNAME,P SBMUDV,PSB STIEN,X,Y
  268   251         S D0=1,PS BMUDV=$S($ $GET1^DIQ( 43,D0,11," I")=1:1,1: 0)
  269   252         I $P($G(^ VA(200,DUZ ,2,0)),U,4 )=0 W !!,$ C(7),"You  have no va lid divisi ons in the  NEW PERSO N file." S  Y="^" Q
  270   253         I '$O(^DG (40.8,"AD" ,DUZ(2),"" )) W !!,$C (7),"Your  NEW PERSON  file divi sion was n ot found i n the MEDI CAL CENTER  DIV
  271                ISION fi le." S Y=" ^" Q
  272   254         I PSBMUDV =1 D CHK1
  273   255         I PSBMUDV =0 D ALL
  274   256         I Y=""!(Y <0)!(Y="^" ) Q
  275   257         S PSBDIV= $P($G(^TMP ("PSBMD",$ J)),U,2)
  276   258         S PSBNAME =$P($G(^TM P("PSBMD", $J)),U,3)
  277   259         ; end of  changes fo r PSB*3*10 0
  278   260         N DIR,PSB IEN,PSBX,D A,DR,DDSFI LE,PSBHDR, PSBDRUG,LO C             ;*70
  279   261         S Y="" F   Q:Y="^"   D
  280   262         .K ^TMP(" PSB",$J) S  X=""
  281   263         .;start P SB*3*100 c hanges: us er did not  select on e division  and will  see all th e records  (single st ation func tion
  282                ality)
  283   264         .I $G(PSB MUDV)=0 D
  284   265         ..F  S X= $O(^PSB(53 .68,"AS",1 ,X),-1) Q: 'X  S Y=$O (^TMP("PSB ",$J,""),- 1)+1,^TMP( "PSB",$J,Y )=X,^TMP(" PSB",$J,0) =Y
  285   266         .;
  286   267         .; user s elected on e division
  287   268         .I $G(PSB MUDV)=1 D
  288   269         ..F  S X= $O(^PSB(53 .68,"DIVAS ",1,PSBDIV ,X),-1) Q: 'X  S Y=$O (^TMP("PSB ",$J,""),- 1)+1,^TMP( "PSB",$J,Y )=X,^TMP(" PSB"
  289                ,$J,0)=Y
  290   270         .;
  291   271         .I '$O(^T MP("PSB",$ J,0)) W !! ,"No Unres olved Miss ing Dose R equests Fo und." S Y= "^" Q
  292   272         .I $G(PSB MUDV)=0 S  PSBHDR="Cu rrently Un resolved M issing Dos e Requests "
  293   273         .I $G(PSB MUDV)=1 S  PSBHDR="Cu rrently Un resolved M issing Dos e Requests  for: "_PS BNAME
  294   274         .;end of  changes fo r PSB*3*10 0
  295   275         .W @IOF,P SBHDR,!,$T R($J("",IO M)," ","-" )
  296   276         .F PSBX=0 :0 S PSBX= $O(^TMP("P SB",$J,PSB X)) Q:'PSB X!(Y="^")   S PSBIEN= ^(PSBX)_", " D
  297   277         ..W !,$J( PSBX,2),".  ",$$GET1^ DIQ(53.68, PSBIEN,.01 )
  298   278         ..W ?25,$ $GET1^DIQ( 53.68,PSBI EN,.11)
  299   279         ..; get c orrect loc ation                                         ;*70
  300   280         ..S LOC=$ S($$GET1^D IQ(53.68,P SBIEN,1)]" ":$$GET1^D IQ(53.68,P SBIEN,1),1 :$$GET1^DI Q(53.68,PS BIEN,.12))
  301   281         ..W ?57,L OC                                                       ;*70
  302   282         ..S PSBDR UG=$$GET1^ DIQ(53.68, PSBIEN,.13 )
  303   283         ..I PSBDR UG]"" W !? 5,PSBDRUG
  304   284         ..I PSBDR UG="" D
  305   285         ...W !?5, "UNIQUE ID : ",$$GET1 ^DIQ(53.68 ,PSBIEN,.2 5)
  306   286         ...S X=0  F  S X=$O( ^PSB(53.68 ,+PSBIEN,. 6,X)) Q:'X   W !?10," ADDITIVES:   ",$$GET1 ^DIQ(52.6, +^PSB(53.6 8,+PSBIEN, .6,X
  307                ,0),.01)
  308   287         ...S X=0  F  S X=$O( ^PSB(53.68 ,+PSBIEN,. 7,X)) Q:'X   W !?10," SOLUTIONS:   ",$$GET1 ^DIQ(52.7, +^PSB(53.6 8,+PSBIEN, .7,X
  309                ,0),.01)
  310   288         ..S:$Y>(I OSL-4) Y=$ $PAGE(PSBX )
  311   289         .S:Y'="^"  Y=$$PAGE( PSBX)
  312   290         K ^TMP("P SB",$J),^T MP("PSBMD" ,$J) ; PSB *3*100
  313   291         Q
  314   292         ;
  315   293 PAGE(P SBIX) --
  316                ;
  317   294         ;
  318   295         N X,X1,PS BCX,PSBDX
  319   296         S DIR("A" )="Select  Missing Do se Request  # (<RET>  to continu e, '^' to  quit)"
  320   297         I PSBIX=" " S DIR("A ")="Select  Missing D ose Reques t # (<RET>  or '^' to  quit)"
  321   298         S DIR(0)= "NO^1:"_$S (PSBIX="": $O(^TMP("P SB",$J,PSB X),-1),1:P SBIX)_":0"
  322   299         D ^DIR S  PSBDX=+Y
  323   300         I PSBIX=" ",Y="" S Y ="^" Q Y
  324   301         I $G(DTOU T) S Y="^"  Q Y
  325   302         I Y="^" Q  Y
  326   303         I Y="" W  @IOF,PSBHD R,!,$TR($J ("",IOM),"  ","-") Q  Y
  327   304         S (DA,PSB CX)=^TMP(" PSB",$J,+Y ),DR="[PSB  MISSING D OSE FOLLOW UP]",DDSFI LE=53.68
  328   305         D  Q Y
  329   306         .D ^DDS
  330   307         .; start  changes fo r PSB*3*10 0
  331   308         .I $G(PSB MUDV)=0,$D (^PSB(53.6 8,"AS",0,P SBCX)) K ^ TMP("PSB", $J) S X=""  F  S X=$O (^PSB(53.6 8,"AS",1,X ),-1) Q:'X   S 
  332                X1=$O(^T MP("PSB",$ J,""),-1)+ 1,^TMP("PS B",$J,X1)= X,^TMP("PS B",$J,0)=X 1
  333   309         .I $G(PSB MUDV)=1,$D (^PSB(53.6 8,"DIVAS", 0,PSBDIV))  K ^TMP("P SB",$J) S  X="" F  S  X=$O(^PSB( 53.68,"DIV AS",1,PSBD IV,X
  334                ),-1) Q: 'X  S X1=$ O(^TMP("PS B",$J,""), -1)+1,^TMP ("PSB",$J, X1)=X,^TMP ("PSB",$J, 0)=X1
  335   310         .; stop p rinting he ader twice  (old bug)  by checki ng PSBX be fore setti ng it to z ero.
  336   311         .I PSBX>0  S PSBX=0  W @IOF,PSB HDR,!,$TR( $J("",IOM) ," ","-")
  337   312         ; end of  changes fo r PSB*3*10 0
  338   313         ;
  339   314 POST    ;call fro m 'Patient ' field of  screenman  form PSB  MISSING DO SE REQUEST
  340   315         ; 
  341   316         N DFN
  342   317         S DFN=X D  IN5^VADPT
  343   318         D PUT^DDS VAL(DIE,.D A,.12,$P(V AIP(5),U,2 ))  ; valu e of DIE i s 53.68, B CMA MISSIN G DOSE REQ UEST FILE  called fro m Sc
  344                reenMan
  345   319         D PUT^DDS VAL(DIE,.D A,.18,$P(V AIP(6),U,1 ),"","I")   ; value o f DIE is 5 3.68, BCMA  MISSING D OSE REQUES T FILE cal led 
  346                from Scr eenMan
  347   320         D REFRESH ^DDSUTL
  348   321         Q