PSOR52 ;IHS/DSD/JCM - Files refill entries in prescription file ;03/10/93
 ;;7.0;OUTPATIENT PHARMACY;**10,22,27,181,148,201,260,281,358,385,408,532,562,654,699**;DEC 1997;Build 2
 ;Reference to ^PSDRUG supported by DBIA 221
 ;Reference to PSOUL^PSSLOCK supported by DBIA 2789
 ;Reference SWSTAT^IBBAPI supported by DBIA 4663
 ;Reference SAVNDC^PSSNDCUT supported by DBIA 4707
 ; This routine is responsible for the actual
 ; filling of the refill prescription.
 ;---------------------------------------------------------   
EN(PSOX) ;Entry Point
START ;
 D:$D(XRTL) T0^%ZOSV ; Start RT monitor
 D INIT G:PSOR52("QFLG") END
 D FILE
 D DIK
 S:$D(XRT0) XRTN=$T(+0) D:$D(XRT0) T1^%ZOSV ; Stop RT Monitor
 D FINISH
END D EOJ
 Q
 ;---------------------------------------------------------
 ;
INIT ;
 S PSOR52("QFLG")=0
 S PSOX("QTY")=$P(PSOX("RX0"),"^",7),PSOX("DAYS SUPPLY")=$P(PSOX("RX0"),"^",8)
 S PSOX("ADMINCLINIC")=$G(PSORX("ADMINCLINIC"))
 S:$G(^PSDRUG($P(PSOX("RX0"),"^",6),660))]"" PSOX("COST")=$P(^PSDRUG($P(PSOX("RX0"),"^",6),660),"^",6)
 D NOW^%DTC S PSOX("LOGIN DATE")=$E(%,1,7)
 S X1=PSOX("FILL DATE"),X2=PSOX("DAYS SUPPLY")-10\1 D C^%DTC S PSOX1=X
 S X1=$P(PSOX("RX2"),"^",2)
 S X2=PSOX("DAYS SUPPLY")*(PSOX("NUMBER")+1)-10\1
 D C^%DTC S PSOX2=X
 S PSOX("NEXT POSSIBLE REFILL")=$S(PSOX1>PSOX2:PSOX1,1:PSOX2)
 K X,PSOX1,PSOX2
 S (PSOX("LAST DISPENSED DATE"),PSOX("DISPENSED DATE"))=PSOX("FILL DATE")
 I $G(PSOX("MAIL/WINDOW"))="" S PSOX("MAIL/WINDOW")="W"  ;*532
 I PSOX("FILL DATE")>$S($G(PSOX("LOGIN DATE")):$E(PSOX("LOGIN DATE"),1,7),1:DT),$P(PSOPAR,"^",6) D
 .S PSOX("OLD MAIL/WINDOW")=$S($G(PSOX("MAIL/WINDOW"))]"":PSOX("MAIL/WINDOW"),1:"MAIL"),PSOX("MAIL/WINDOW")="M"
 I $P(PSOX("RX2"),"^",12)]"" S PSOX("GENERIC PROVIDER")=$P(PSOX("RX2"),"^",12)
 S PSOX("PROVIDER")=$P(PSOX("RX0"),"^",4)
 S:'$D(PSOX("CLERK CODE")) PSOX("CLERK CODE")=DUZ
 S PSOX("DAW")=$$GETDAW^PSODAWUT(+PSOX("IRXN")),PSOX("NDC")=$$GETNDC^PSSNDCUT($P(PSOX("RX0"),"^",6))
INITX Q
 ;
FILE ;     
 ;L +^PSRX(PSOX("IRXN")):0
 I '$D(^PSRX(PSOX("IRXN"),1,0)) S ^(0)="^52.1DA^1^1"
 E  S ^PSRX(PSOX("IRXN"),1,0)=$P(^PSRX(PSOX("IRXN"),1,0),"^",1,2)_"^"_PSOX("NUMBER")_"^"_($P(^(0),"^",4)+1)
 F PSOX1=1:1 S PSOR52=$P($T(DD+PSOX1),";;",2,4) Q:PSOR52=""  K PSOY S PSOY=$P(PSOR52,";;") I $D(@PSOY) S $P(PSOR52(PSOX("IRXN"),1,PSOX("NUMBER"),$P(PSOR52,";;",2)),"^",$P(PSOR52,";;",3))=@PSOY
 K PSOX1,PSOY
 S PSOX1="" F  S PSOX1=$O(PSOR52(PSOX("IRXN"),1,PSOX("NUMBER"),PSOX1)) Q:PSOX1=""  S ^PSRX(PSOX("IRXN"),1,PSOX("NUMBER"),PSOX1)=$G(PSOR52(PSOX("IRXN"),1,PSOX("NUMBER"),PSOX1))
 K PSOX1
 S:PSOX("STA")=6 $P(^PSRX(PSOX("IRXN"),"STA"),"^")=0
 S $P(^PSRX(PSOX("IRXN"),3),"^",1,2)=PSOX("LAST DISPENSED DATE")_"^"_PSOX("NEXT POSSIBLE REFILL")
 S $P(^PSRX(PSOX("IRXN"),3),"^",4)=PSOX("LAST REFILL DATE")
 I $D(PSOX("METHOD OF PICK-UP")),PSOX("FILL DATE")'>DT S $P(^PSRX(PSOX("IRXN"),"MP"),"^")=PSOX("METHOD OF PICK-UP")
 D:$$SWSTAT^IBBAPI() GACT^PSOPFSU0(PSOX("IRXN"),PSOX("NUMBER"))
 ;L -^PSRX(PSOX("IRXN"))
 Q
 ;
DIK ;
 K DIK,DA
 S DIK="^PSRX(",DA=PSOX("IRXN") D IX1^DIK K DIK
 I +$G(^PSRX(DA,"IB")),$P(^PSRX(DA,1,PSOX("NUMBER"),0),"^",2)="W" S ^PSRX("ACP",$P(^PSRX(DA,0),"^",2),$P(^PSRX(DA,1,PSOX("NUMBER"),0),"^"),PSOX("NUMBER"),DA)="" K DA
 D:$T(EN^PSOHDR)]"" EN^PSOHDR("PREF",PSOX("IRXN"))
 Q
 ;
FINISH ;
 I $G(PSOX("QS"))="S" D  G FINISHX
 . S DA=PSOX("IRXN"),RXFL(PSOX("IRXN"))=PSOX("NUMBER")
 . D SUS^PSORXL K DA
 ;
 ; - Previous ePharmacy Refill was Deleted and a new one is being entered
 I '$$SUBMIT^PSOBPSUT(PSOX("IRXN"),PSOX("NUMBER")),$$STATUS^PSOBPSUT(PSOX("IRXN"),PSOX("NUMBER"))'="" D
 . D RETRXF^PSOREJU2(PSOX("IRXN"),PSOX("NUMBER"),1)
 ;
 I PSOX("FILL DATE")>$S($G(PSOX("LOGIN DATE")):$E(PSOX("LOGIN DATE"),1,7),1:DT),$P(PSOPAR,"^",6) D  G FINISHX
 .K PSOXRXFL I $D(RXFL(PSOX("IRXN"))) S PSOXRXFL=$G(RXFL(PSOX("IRXN")))
 .S DA=PSOX("IRXN"),RXFL(PSOX("IRXN"))=PSOX("NUMBER")
 .D SUS^PSORXL K DA
 .I $G(PSOXRXFL)'="" S RXFL(PSOX("IRXN"))=$G(PSOXRXFL) K PSOXRXFL
 ;
 ; - Calling ECME for claims generation and transmission / REJECT handling
 N ACTION,PSOERX,PSOERF
 S PSOERX=PSOX("IRXN"),PSOERF=PSOX("NUMBER")
 I $$SUBMIT^PSOBPSUT(PSOERX,PSOERF) D  I ACTION="Q"!(ACTION="^") Q
 . S ACTION="" D ECMESND^PSOBPSU1(PSOERX,PSOERF,"","RF")
 . ; Quit if there is an unresolved TRICARE/CHAMPVA non-billable reject code, PSO*7*358
 . I $$PSOET^PSOREJP3(PSOERX,PSOERF) S ACTION="Q" Q
 . I $$FIND^PSOREJUT(PSOERX,PSOERF) D
 . . S ACTION=$$HDLG^PSOREJU1(PSOERX,PSOERF,"79,88,943","OF","IOQ","Q")
 . I $$STATUS^PSOBPSUT(PSOERX,PSOERF)="E PAYABLE" D
 . . D SAVNDC^PSSNDCUT(+$$GET1^DIQ(52,PSOERX,6,"I"),$G(PSOSITE),$$GETNDC^PSONDCUT(PSOERX,PSOERF))
 ;
 I $G(PSOX("QS"))="Q" D  G FINISHX
 . I $G(PPL),$L(PPL_PSOX("IRXN")_",")>240 D TRI^PSOBBC D Q^PSORXL K PPL,RXFL
 . S RXFL(PSOX("IRXN"))=PSOX("NUMBER")
 . I $G(PPL) S PPL=PPL_PSOX("IRXN")_","
 . E  S PPL=PSOX("IRXN")_","
 ;
 N PSODUP       ;P654
 I $G(PSORX("PSOL",1))']"" S PSORX("PSOL",1)=PSOX("IRXN")_",",RXFL(PSOX("IRXN"))=PSOX("NUMBER") G FINISHX
 S PSODUP=0 F PSOX1=0:0 S PSOX1=$O(PSORX("PSOL",PSOX1)) Q:'PSOX1  S PSOX2=PSOX1 I PSORX("PSOL",PSOX1)[PSOX("IRXN") S PSODUP=1 Q
 ;p699 Do not skip setting RXFL if PSODUP is true
 I 'PSODUP D
 . I $L(PSORX("PSOL",PSOX2))+$L(PSOX("IRXN"))<220 S PSORX("PSOL",PSOX2)=PSORX("PSOL",PSOX2)_PSOX("IRXN")_","
 . E  S PSORX("PSOL",PSOX2+1)=PSOX("IRXN")_","
 S RXFL(PSOX("IRXN"))=PSOX("NUMBER")
 ;
FINISHX ; 
 I $G(PSORX("MAIL/WINDOW"))["W" S BINGCRT=1,BINGRTE="W",BBFLG=1 D BBRX^PSORN52C
 K PSOX1,PSOX2
 Q
EOJ ;
 I $D(PSOX("OLD MAIL/WINDOW")) S PSOX("MAIL/WINDOW")=PSOX("OLD MAIL/WINDOW") K PSOX("OLD MAIL/WINDOW")
 S DA=$O(^PS(52.41,"ARF",PSOX("IRXN"),0)) I DA D  S DIK="^PS(52.41," D ^DIK
 .S PSORFKL=DA D PSOUL^PSSLOCK(PSORFKL_"S") K PSORFKL
 K PSOR52,DA,DIK
 Q
 ;
DD ;rx data nodes
 ;;PSOX("PROVIDER");;0;;17
 ;;PSOX("QTY");;0;;4
 ;;PSOX("DAYS SUPPLY");;0;;10
 ;;PSOX("MAIL/WINDOW");;0;;2
 ;;PSOX("REMARKS");;0;;3
 ;;PSOX("CLERK CODE");;0;;7
 ;;PSOX("COST");;0;;11
 ;;PSOSITE;;0;;9
 ;;PSOX("LOGIN DATE");;0;;8
 ;;PSOX("FILL DATE");;0;;1
 ;;PSOX("PHARMACIST");;0;;5
 ;;PSOX("LOT #");;0;;6
 ;;PSOX("DISPENSED DATE");;0;;19
 ;;PSOX("ADMINCLINIC");;0;;20
 ;;PSOX("NDC");;1;;3
 ;;PSOX("DAW");;EPH;;1
 ;;PSOX("MANUFACTURER");;0;;14
 ;;PSOX("EXPIRATION DATE");;0;;15
 ;;PSOX("GENERIC PROVIDER");;1;;1
 ;;PSOX("RELEASED DATE/TIME");;0;;18
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOR52   6434     printed  Sep 23, 2025@20:09:50                                                                                                                                                                                                      Page 2
PSOR52    ;IHS/DSD/JCM - Files refill entries in prescription file ;03/10/93
 +1       ;;7.0;OUTPATIENT PHARMACY;**10,22,27,181,148,201,260,281,358,385,408,532,562,654,699**;DEC 1997;Build 2
 +2       ;Reference to ^PSDRUG supported by DBIA 221
 +3       ;Reference to PSOUL^PSSLOCK supported by DBIA 2789
 +4       ;Reference SWSTAT^IBBAPI supported by DBIA 4663
 +5       ;Reference SAVNDC^PSSNDCUT supported by DBIA 4707
 +6       ; This routine is responsible for the actual
 +7       ; filling of the refill prescription.
 +8       ;---------------------------------------------------------   
EN(PSOX)  ;Entry Point
START     ;
 +1       ; Start RT monitor
           if $DATA(XRTL)
               DO T0^%ZOSV
 +2        DO INIT
           if PSOR52("QFLG")
               GOTO END
 +3        DO FILE
 +4        DO DIK
 +5       ; Stop RT Monitor
           if $DATA(XRT0)
               SET XRTN=$TEXT(+0)
           if $DATA(XRT0)
               DO T1^%ZOSV
 +6        DO FINISH
END        DO EOJ
 +1        QUIT 
 +2       ;---------------------------------------------------------
 +3       ;
INIT      ;
 +1        SET PSOR52("QFLG")=0
 +2        SET PSOX("QTY")=$PIECE(PSOX("RX0"),"^",7)
           SET PSOX("DAYS SUPPLY")=$PIECE(PSOX("RX0"),"^",8)
 +3        SET PSOX("ADMINCLINIC")=$GET(PSORX("ADMINCLINIC"))
 +4        if $GET(^PSDRUG($PIECE(PSOX("RX0"),"^",6),660))]""
               SET PSOX("COST")=$PIECE(^PSDRUG($PIECE(PSOX("RX0"),"^",6),660),"^",6)
 +5        DO NOW^%DTC
           SET PSOX("LOGIN DATE")=$EXTRACT(%,1,7)
 +6        SET X1=PSOX("FILL DATE")
           SET X2=PSOX("DAYS SUPPLY")-10\1
           DO C^%DTC
           SET PSOX1=X
 +7        SET X1=$PIECE(PSOX("RX2"),"^",2)
 +8        SET X2=PSOX("DAYS SUPPLY")*(PSOX("NUMBER")+1)-10\1
 +9        DO C^%DTC
           SET PSOX2=X
 +10       SET PSOX("NEXT POSSIBLE REFILL")=$SELECT(PSOX1>PSOX2:PSOX1,1:PSOX2)
 +11       KILL X,PSOX1,PSOX2
 +12       SET (PSOX("LAST DISPENSED DATE"),PSOX("DISPENSED DATE"))=PSOX("FILL DATE")
 +13      ;*532
           IF $GET(PSOX("MAIL/WINDOW"))=""
               SET PSOX("MAIL/WINDOW")="W"
 +14       IF PSOX("FILL DATE")>$SELECT($GET(PSOX("LOGIN DATE")):$EXTRACT(PSOX("LOGIN DATE"),1,7),1:DT)
               IF $PIECE(PSOPAR,"^",6)
                   Begin DoDot:1
 +15                   SET PSOX("OLD MAIL/WINDOW")=$SELECT($GET(PSOX("MAIL/WINDOW"))]"":PSOX("MAIL/WINDOW"),1:"MAIL")
                       SET PSOX("MAIL/WINDOW")="M"
                   End DoDot:1
 +16       IF $PIECE(PSOX("RX2"),"^",12)]""
               SET PSOX("GENERIC PROVIDER")=$PIECE(PSOX("RX2"),"^",12)
 +17       SET PSOX("PROVIDER")=$PIECE(PSOX("RX0"),"^",4)
 +18       if '$DATA(PSOX("CLERK CODE"))
               SET PSOX("CLERK CODE")=DUZ
 +19       SET PSOX("DAW")=$$GETDAW^PSODAWUT(+PSOX("IRXN"))
           SET PSOX("NDC")=$$GETNDC^PSSNDCUT($PIECE(PSOX("RX0"),"^",6))
INITX      QUIT 
 +1       ;
FILE      ;     
 +1       ;L +^PSRX(PSOX("IRXN")):0
 +2        IF '$DATA(^PSRX(PSOX("IRXN"),1,0))
               SET ^(0)="^52.1DA^1^1"
 +3       IF '$TEST
               SET ^PSRX(PSOX("IRXN"),1,0)=$PIECE(^PSRX(PSOX("IRXN"),1,0),"^",1,2)_"^"_PSOX("NUMBER")_"^"_($PIECE(^(0),"^",4)+1)
 +4        FOR PSOX1=1:1
               SET PSOR52=$PIECE($TEXT(DD+PSOX1),";;",2,4)
               if PSOR52=""
                   QUIT 
               KILL PSOY
               SET PSOY=$PIECE(PSOR52,";;")
               IF $DATA(@PSOY)
                   SET $PIECE(PSOR52(PSOX("IRXN"),1,PSOX("NUMBER"),$PIECE(PSOR52,";;",2)),"^",$PIECE(PSOR52,";;",3))=@PSOY
 +5        KILL PSOX1,PSOY
 +6        SET PSOX1=""
           FOR 
               SET PSOX1=$ORDER(PSOR52(PSOX("IRXN"),1,PSOX("NUMBER"),PSOX1))
               if PSOX1=""
                   QUIT 
               SET ^PSRX(PSOX("IRXN"),1,PSOX("NUMBER"),PSOX1)=$GET(PSOR52(PSOX("IRXN"),1,PSOX("NUMBER"),PSOX1))
 +7        KILL PSOX1
 +8        if PSOX("STA")=6
               SET $PIECE(^PSRX(PSOX("IRXN"),"STA"),"^")=0
 +9        SET $PIECE(^PSRX(PSOX("IRXN"),3),"^",1,2)=PSOX("LAST DISPENSED DATE")_"^"_PSOX("NEXT POSSIBLE REFILL")
 +10       SET $PIECE(^PSRX(PSOX("IRXN"),3),"^",4)=PSOX("LAST REFILL DATE")
 +11       IF $DATA(PSOX("METHOD OF PICK-UP"))
               IF PSOX("FILL DATE")'>DT
                   SET $PIECE(^PSRX(PSOX("IRXN"),"MP"),"^")=PSOX("METHOD OF PICK-UP")
 +12       if $$SWSTAT^IBBAPI()
               DO GACT^PSOPFSU0(PSOX("IRXN"),PSOX("NUMBER"))
 +13      ;L -^PSRX(PSOX("IRXN"))
 +14       QUIT 
 +15      ;
DIK       ;
 +1        KILL DIK,DA
 +2        SET DIK="^PSRX("
           SET DA=PSOX("IRXN")
           DO IX1^DIK
           KILL DIK
 +3        IF +$GET(^PSRX(DA,"IB"))
               IF $PIECE(^PSRX(DA,1,PSOX("NUMBER"),0),"^",2)="W"
                   SET ^PSRX("ACP",$PIECE(^PSRX(DA,0),"^",2),$PIECE(^PSRX(DA,1,PSOX("NUMBER"),0),"^"),PSOX("NUMBER"),DA)=""
                   KILL DA
 +4        if $TEXT(EN^PSOHDR)]""
               DO EN^PSOHDR("PREF",PSOX("IRXN"))
 +5        QUIT 
 +6       ;
FINISH    ;
 +1        IF $GET(PSOX("QS"))="S"
               Begin DoDot:1
 +2                SET DA=PSOX("IRXN")
                   SET RXFL(PSOX("IRXN"))=PSOX("NUMBER")
 +3                DO SUS^PSORXL
                   KILL DA
               End DoDot:1
               GOTO FINISHX
 +4       ;
 +5       ; - Previous ePharmacy Refill was Deleted and a new one is being entered
 +6        IF '$$SUBMIT^PSOBPSUT(PSOX("IRXN"),PSOX("NUMBER"))
               IF $$STATUS^PSOBPSUT(PSOX("IRXN"),PSOX("NUMBER"))'=""
                   Begin DoDot:1
 +7                    DO RETRXF^PSOREJU2(PSOX("IRXN"),PSOX("NUMBER"),1)
                   End DoDot:1
 +8       ;
 +9        IF PSOX("FILL DATE")>$SELECT($GET(PSOX("LOGIN DATE")):$EXTRACT(PSOX("LOGIN DATE"),1,7),1:DT)
               IF $PIECE(PSOPAR,"^",6)
                   Begin DoDot:1
 +10                   KILL PSOXRXFL
                       IF $DATA(RXFL(PSOX("IRXN")))
                           SET PSOXRXFL=$GET(RXFL(PSOX("IRXN")))
 +11                   SET DA=PSOX("IRXN")
                       SET RXFL(PSOX("IRXN"))=PSOX("NUMBER")
 +12                   DO SUS^PSORXL
                       KILL DA
 +13                   IF $GET(PSOXRXFL)'=""
                           SET RXFL(PSOX("IRXN"))=$GET(PSOXRXFL)
                           KILL PSOXRXFL
                   End DoDot:1
                   GOTO FINISHX
 +14      ;
 +15      ; - Calling ECME for claims generation and transmission / REJECT handling
 +16       NEW ACTION,PSOERX,PSOERF
 +17       SET PSOERX=PSOX("IRXN")
           SET PSOERF=PSOX("NUMBER")
 +18       IF $$SUBMIT^PSOBPSUT(PSOERX,PSOERF)
               Begin DoDot:1
 +19               SET ACTION=""
                   DO ECMESND^PSOBPSU1(PSOERX,PSOERF,"","RF")
 +20      ; Quit if there is an unresolved TRICARE/CHAMPVA non-billable reject code, PSO*7*358
 +21               IF $$PSOET^PSOREJP3(PSOERX,PSOERF)
                       SET ACTION="Q"
                       QUIT 
 +22               IF $$FIND^PSOREJUT(PSOERX,PSOERF)
                       Begin DoDot:2
 +23                       SET ACTION=$$HDLG^PSOREJU1(PSOERX,PSOERF,"79,88,943","OF","IOQ","Q")
                       End DoDot:2
 +24               IF $$STATUS^PSOBPSUT(PSOERX,PSOERF)="E PAYABLE"
                       Begin DoDot:2
 +25                       DO SAVNDC^PSSNDCUT(+$$GET1^DIQ(52,PSOERX,6,"I"),$GET(PSOSITE),$$GETNDC^PSONDCUT(PSOERX,PSOERF))
                       End DoDot:2
               End DoDot:1
               IF ACTION="Q"!(ACTION="^")
                   QUIT 
 +26      ;
 +27       IF $GET(PSOX("QS"))="Q"
               Begin DoDot:1
 +28               IF $GET(PPL)
                       IF $LENGTH(PPL_PSOX("IRXN")_",")>240
                           DO TRI^PSOBBC
                           DO Q^PSORXL
                           KILL PPL,RXFL
 +29               SET RXFL(PSOX("IRXN"))=PSOX("NUMBER")
 +30               IF $GET(PPL)
                       SET PPL=PPL_PSOX("IRXN")_","
 +31              IF '$TEST
                       SET PPL=PSOX("IRXN")_","
               End DoDot:1
               GOTO FINISHX
 +32      ;
 +33      ;P654
           NEW PSODUP
 +34       IF $GET(PSORX("PSOL",1))']""
               SET PSORX("PSOL",1)=PSOX("IRXN")_","
               SET RXFL(PSOX("IRXN"))=PSOX("NUMBER")
               GOTO FINISHX
 +35       SET PSODUP=0
           FOR PSOX1=0:0
               SET PSOX1=$ORDER(PSORX("PSOL",PSOX1))
               if 'PSOX1
                   QUIT 
               SET PSOX2=PSOX1
               IF PSORX("PSOL",PSOX1)[PSOX("IRXN")
                   SET PSODUP=1
                   QUIT 
 +36      ;p699 Do not skip setting RXFL if PSODUP is true
 +37       IF 'PSODUP
               Begin DoDot:1
 +38               IF $LENGTH(PSORX("PSOL",PSOX2))+$LENGTH(PSOX("IRXN"))<220
                       SET PSORX("PSOL",PSOX2)=PSORX("PSOL",PSOX2)_PSOX("IRXN")_","
 +39              IF '$TEST
                       SET PSORX("PSOL",PSOX2+1)=PSOX("IRXN")_","
               End DoDot:1
 +40       SET RXFL(PSOX("IRXN"))=PSOX("NUMBER")
 +41      ;
FINISHX   ; 
 +1        IF $GET(PSORX("MAIL/WINDOW"))["W"
               SET BINGCRT=1
               SET BINGRTE="W"
               SET BBFLG=1
               DO BBRX^PSORN52C
 +2        KILL PSOX1,PSOX2
 +3        QUIT 
EOJ       ;
 +1        IF $DATA(PSOX("OLD MAIL/WINDOW"))
               SET PSOX("MAIL/WINDOW")=PSOX("OLD MAIL/WINDOW")
               KILL PSOX("OLD MAIL/WINDOW")
 +2        SET DA=$ORDER(^PS(52.41,"ARF",PSOX("IRXN"),0))
           IF DA
               Begin DoDot:1
 +3                SET PSORFKL=DA
                   DO PSOUL^PSSLOCK(PSORFKL_"S")
                   KILL PSORFKL
               End DoDot:1
               SET DIK="^PS(52.41,"
               DO ^DIK
 +4        KILL PSOR52,DA,DIK
 +5        QUIT 
 +6       ;
DD        ;rx data nodes
 +1       ;;PSOX("PROVIDER");;0;;17
 +2       ;;PSOX("QTY");;0;;4
 +3       ;;PSOX("DAYS SUPPLY");;0;;10
 +4       ;;PSOX("MAIL/WINDOW");;0;;2
 +5       ;;PSOX("REMARKS");;0;;3
 +6       ;;PSOX("CLERK CODE");;0;;7
 +7       ;;PSOX("COST");;0;;11
 +8       ;;PSOSITE;;0;;9
 +9       ;;PSOX("LOGIN DATE");;0;;8
 +10      ;;PSOX("FILL DATE");;0;;1
 +11      ;;PSOX("PHARMACIST");;0;;5
 +12      ;;PSOX("LOT #");;0;;6
 +13      ;;PSOX("DISPENSED DATE");;0;;19
 +14      ;;PSOX("ADMINCLINIC");;0;;20
 +15      ;;PSOX("NDC");;1;;3
 +16      ;;PSOX("DAW");;EPH;;1
 +17      ;;PSOX("MANUFACTURER");;0;;14
 +18      ;;PSOX("EXPIRATION DATE");;0;;15
 +19      ;;PSOX("GENERIC PROVIDER");;1;;1
 +20      ;;PSOX("RELEASED DATE/TIME");;0;;18