PSOR52 ;IHS/DSD/JCM-files refill entries in prescription file ;23-Sep-2013 16:30;PLS
;;7.0;OUTPATIENT PHARMACY;**10,22,27,1005,1006,1013,181,148,201,260,281,1015,1016**;DEC 1997;Build 74
;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.
;---------------------------------------------------------
; Modified - IHS/CIA/PLS - 01/06/04 - DD section
; IHS/MSC/PLS - 05/16/07 - DD section
; 05/27/06 - FINISH+13 section - AudioCare
; 10/24/07 - DD section
; 06/01/10 - Line FILE+12
; 09/27/11 - APSPPRIO support
; 11/20/12 - RXNORM CODE support
; 03/06/13 - Line DD-1
; 09/23/13 - Line INIT+17
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:$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 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
;IHS/MSC/PLS - 09/23/2013
;S PSOX("DAW")=$$GETDAW^PSODAWUT(+PSOX("IRXN")),PSOX("NDC")=$$GETNDC^PSSNDCUT($P(PSOX("RX0"),"^",6))
S:$L($G(APSPPRIO)) PSOX("APSPPRIO")=APSPPRIO ;IHS/MSC/PLS - 09/27/11
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")
;IHS/MSC/PLS - 06/01/2010
;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,PSOX("FILL DATE"),"RF")
. I $$FIND^PSOREJUT(PSOERX,PSOERF) D
. . S ACTION=$$HDLG^PSOREJU1(PSOERX,PSOERF,"79,88","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
.; IHS/MSC/PLS - 05/27/06 - Next two lines modified to support AudioCare
. I $G(PPL),$L(PPL_PSOX("IRXN")_",")>240 D ; D TRI^PSOBBC D Q^PSORXL K PPL,RXFL
..D PROCESSX^PSOBBC K RXFL ;IHS/MSC/PLS - 05/27/06
. S RXFL(PSOX("IRXN"))=PSOX("NUMBER")
. I $G(PPL) S PPL=PPL_PSOX("IRXN")_","
. E S PPL=PSOX("IRXN")_","
;
I $G(PSORX("PSOL",1))']"" S PSORX("PSOL",1)=PSOX("IRXN")_",",RXFL(PSOX("IRXN"))=PSOX("NUMBER") G FINISHX
F PSOX1=0:0 S PSOX1=$O(PSORX("PSOL",PSOX1)) Q:'PSOX1 S PSOX2=PSOX1
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
;
;;PSOX("DAW");;EPH;;1
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("NDC");;1;;3
;;PSOX("MANUFACTURER");;0;;14
;;PSOX("EXPIRATION DATE");;0;;15
;;PSOX("GENERIC PROVIDER");;1;;1
;;PSOX("RELEASED DATE/TIME");;0;;18
;;PSOX("AWP");;9999999;;6 ;IHS/OKCAO/POC 11/12/98 FOR AWP
;;PSOX("BST");;9999999;;7 ;IHS/OKCAO/POC 8/18/2000
;;PSOX("INSURER");;9999999;;12 ;IHS/OKCAO/POC 8/18/2000
;;PSOX("DUR");;9999999;;13 ;IHS/SD/lwj 6/24/2003
;;PSOX("CLINIC");;9999999;;16 ;IHS/MSC/PLS 05/16/06
;;PSOX("REQ PROVIDER");;9999999;;1 ; IHS/MSC/PLS 10/24/2007
;;PSOX("APSPPRIO");;9999999;;18 ;IHS/MSC/PLS - 09/27/2011
;;PSOX("RXNORM");;9999999;;19 ;IHS/MSC/PLS - 11/20/2012
PSOR52 ;IHS/DSD/JCM-files refill entries in prescription file ;23-Sep-2013 16:30;PLS
+1 ;;7.0;OUTPATIENT PHARMACY;**10,22,27,1005,1006,1013,181,148,201,260,281,1015,1016**;DEC 1997;Build 74
+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 ;---------------------------------------------------------
+9 ; Modified - IHS/CIA/PLS - 01/06/04 - DD section
+10 ; IHS/MSC/PLS - 05/16/07 - DD section
+11 ; 05/27/06 - FINISH+13 section - AudioCare
+12 ; 10/24/07 - DD section
+13 ; 06/01/10 - Line FILE+12
+14 ; 09/27/11 - APSPPRIO support
+15 ; 11/20/12 - RXNORM CODE support
+16 ; 03/06/13 - Line DD-1
+17 ; 09/23/13 - Line INIT+17
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 IF $GET(^PSDRUG($PIECE(PSOX("RX0"),"^",6),660))]""
SET PSOX("COST")=$PIECE(^PSDRUG($PIECE(PSOX("RX0"),"^",6),660),"^",6)
+4 DO NOW^%DTC
SET PSOX("LOGIN DATE")=$EXTRACT(%,1,7)
+5 SET X1=PSOX("FILL DATE")
SET X2=PSOX("DAYS SUPPLY")-10\1
DO C^%DTC
SET PSOX1=X
+6 SET X1=$PIECE(PSOX("RX2"),"^",2)
+7 SET X2=PSOX("DAYS SUPPLY")*(PSOX("NUMBER")+1)-10\1
+8 DO C^%DTC
SET PSOX2=X
+9 SET PSOX("NEXT POSSIBLE REFILL")=$SELECT(PSOX1>PSOX2:PSOX1,1:PSOX2)
+10 KILL X,PSOX1,PSOX2
+11 SET (PSOX("LAST DISPENSED DATE"),PSOX("DISPENSED DATE"))=PSOX("FILL DATE")
+12 IF PSOX("FILL DATE")>$SELECT($GET(PSOX("LOGIN DATE")):$EXTRACT(PSOX("LOGIN DATE"),1,7),1:DT)
IF $PIECE(PSOPAR,"^",6)
Begin DoDot:1
+13 SET PSOX("OLD MAIL/WINDOW")=$SELECT($GET(PSOX("MAIL/WINDOW"))]"":PSOX("MAIL/WINDOW"),1:"MAIL")
SET PSOX("MAIL/WINDOW")="M"
End DoDot:1
+14 IF $PIECE(PSOX("RX2"),"^",12)]""
SET PSOX("GENERIC PROVIDER")=$PIECE(PSOX("RX2"),"^",12)
+15 SET PSOX("PROVIDER")=$PIECE(PSOX("RX0"),"^",4)
+16 IF '$DATA(PSOX("CLERK CODE"))
SET PSOX("CLERK CODE")=DUZ
+17 ;IHS/MSC/PLS - 09/23/2013
+18 ;S PSOX("DAW")=$$GETDAW^PSODAWUT(+PSOX("IRXN")),PSOX("NDC")=$$GETNDC^PSSNDCUT($P(PSOX("RX0"),"^",6))
+19 ;IHS/MSC/PLS - 09/27/11
IF $LENGTH($GET(APSPPRIO))
SET PSOX("APSPPRIO")=APSPPRIO
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 ;IHS/MSC/PLS - 06/01/2010
+13 ;D:$$SWSTAT^IBBAPI() GACT^PSOPFSU0(PSOX("IRXN"),PSOX("NUMBER"))
+14 ;L -^PSRX(PSOX("IRXN"))
+15 QUIT
+16 ;
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,PSOX("FILL DATE"),"RF")
+20 IF $$FIND^PSOREJUT(PSOERX,PSOERF)
Begin DoDot:2
+21 SET ACTION=$$HDLG^PSOREJU1(PSOERX,PSOERF,"79,88","OF","IOQ","Q")
End DoDot:2
+22 IF $$STATUS^PSOBPSUT(PSOERX,PSOERF)="E PAYABLE"
Begin DoDot:2
+23 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
+24 ;
+25 IF $GET(PSOX("QS"))="Q"
Begin DoDot:1
+26 ; IHS/MSC/PLS - 05/27/06 - Next two lines modified to support AudioCare
+27 ; D TRI^PSOBBC D Q^PSORXL K PPL,RXFL
IF $GET(PPL)
IF $LENGTH(PPL_PSOX("IRXN")_",")>240
Begin DoDot:2
+28 ;IHS/MSC/PLS - 05/27/06
DO PROCESSX^PSOBBC
KILL RXFL
End DoDot:2
+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 IF $GET(PSORX("PSOL",1))']""
SET PSORX("PSOL",1)=PSOX("IRXN")_","
SET RXFL(PSOX("IRXN"))=PSOX("NUMBER")
GOTO FINISHX
+34 FOR PSOX1=0:0
SET PSOX1=$ORDER(PSORX("PSOL",PSOX1))
IF 'PSOX1
QUIT
SET PSOX2=PSOX1
+35 IF $LENGTH(PSORX("PSOL",PSOX2))+$LENGTH(PSOX("IRXN"))<220
SET PSORX("PSOL",PSOX2)=PSORX("PSOL",PSOX2)_PSOX("IRXN")_","
+36 IF '$TEST
SET PSORX("PSOL",PSOX2+1)=PSOX("IRXN")_","
+37 SET RXFL(PSOX("IRXN"))=PSOX("NUMBER")
+38 ;
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 ;
+7 ;;PSOX("DAW");;EPH;;1
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("NDC");;1;;3
+15 ;;PSOX("MANUFACTURER");;0;;14
+16 ;;PSOX("EXPIRATION DATE");;0;;15
+17 ;;PSOX("GENERIC PROVIDER");;1;;1
+18 ;;PSOX("RELEASED DATE/TIME");;0;;18
+19 ;;PSOX("AWP");;9999999;;6 ;IHS/OKCAO/POC 11/12/98 FOR AWP
+20 ;;PSOX("BST");;9999999;;7 ;IHS/OKCAO/POC 8/18/2000
+21 ;;PSOX("INSURER");;9999999;;12 ;IHS/OKCAO/POC 8/18/2000
+22 ;;PSOX("DUR");;9999999;;13 ;IHS/SD/lwj 6/24/2003
+23 ;;PSOX("CLINIC");;9999999;;16 ;IHS/MSC/PLS 05/16/06
+24 ;;PSOX("REQ PROVIDER");;9999999;;1 ; IHS/MSC/PLS 10/24/2007
+25 ;;PSOX("APSPPRIO");;9999999;;18 ;IHS/MSC/PLS - 09/27/2011
+26 ;;PSOX("RXNORM");;9999999;;19 ;IHS/MSC/PLS - 11/20/2012
