- PSOHLUP1 ;BIR/RTR-Backfill OERR from Pharmacy (all) ; 7/20/96
- ;;7.0;OUTPATIENT PHARMACY;**10**;DEC 1997
- ;
- ;Backfill all Rx's
- EN ;
- D NOW^%DTC S $P(^PS(59.7,1,49.99),"^",8)=%
- N C,Y,DA,IFN,RXP,DFN,PAT,PSODFN,PSOPPZ,PSOPPQZ,YEAR1,PSOEST,PSOERSTA,PSOPHSTA,X,T,PRU,PSOCV,PTFLAG,III,ZDFN
- I '$G(DT) S DT=$$DT^XLFDT
- S X1=DT,X2=-121 D C^%DTC S YEAR1=X
- F ZDFN=0:0 S ZDFN=$O(^PS(55,ZDFN)) Q:'ZDFN D:'$P($G(^PS(55,ZDFN,0)),"^",6)
- .F PSOPPZ=YEAR1:0 S PSOPPZ=$O(^PS(55,ZDFN,"P","A",PSOPPZ)) Q:'PSOPPZ F PSOPPQZ=0:0 S PSOPPQZ=$O(^PS(55,ZDFN,"P","A",PSOPPZ,PSOPPQZ)) Q:'PSOPPQZ D PAT D:$D(^PSRX(PSOPPQZ,0))&('$P($G(^PSRX(PSOPPQZ,"OR1")),"^",2))&('$G(PTFLAG))
- ..Q:'$P($G(^PSRX(PSOPPQZ,0)),"^",2)
- ..S PSOEST=$S($D(^PSRX(PSOPPQZ,"STA")):$P($G(^PSRX(PSOPPQZ,"STA")),"^"),1:$P($G(^PSRX(PSOPPQZ,0)),"^",15)) Q:PSOEST=10!(PSOEST=13)!(PSOEST=16)!(PSOEST=14)
- ..D:'$P($G(^PSRX(PSOPPQZ,0)),"^",19)
- ...I $P($G(^PSRX(PSOPPQZ,"OR1")),"^")']"",+$G(^PSDRUG(+$P(^PSRX(PSOPPQZ,0),"^",6),2)) S $P(^PSRX(PSOPPQZ,"OR1"),"^")=+$G(^PSDRUG($P(^PSRX(PSOPPQZ,0),"^",6),2))
- ...I $G(^PSRX(PSOPPQZ,"SIG"))']"" S ^PSRX(PSOPPQZ,"SIG")=$P($G(^PSRX(PSOPPQZ,0)),"^",10)_"^"_0 S $P(^PSRX(PSOPPQZ,0),"^",10)=""
- ...S ^PSRX(PSOPPQZ,"STA")=$P($G(^PSRX(PSOPPQZ,0)),"^",15) S $P(^PSRX(PSOPPQZ,0),"^",15)=""
- ...S PR=0 F S PR=$O(^PSRX(PSOPPQZ,"P",PR)) Q:'PR D
- ....I '$P($G(^PSRX(PSOPPQZ,"P",PR,0)),"^") K ^PSRX(PSOPPQZ,"P",PR,0) Q
- ....S ^PSRX("ADP",$E($P(^PSRX(PSOPPQZ,"P",PR,0),"^"),1,7),PSOPPQZ,PR)=""
- ...S $P(^PSRX(PSOPPQZ,0),"^",19)=1
- ..D:'$P($G(^PSRX(PSOPPQZ,"SIG")),"^",2) POP^PSOSIGNO(PSOPPQZ)
- ..D EN^PSOHLSN1(PSOPPQZ,"ZC","")
- ..Q:'$P($G(^PSRX(PSOPPQZ,"OR1")),"^",2)
- ..S PSOEST=$P($G(^PSRX(PSOPPQZ,"STA")),"^")
- ..I +$P($G(^PSRX(PSOPPQZ,2)),"^",6),$P($G(^(2)),"^",6)<DT S $P(^PSRX(PSOPPQZ,"STA"),"^")=11 D ECAN^PSOUTL(PSOPPQZ) S PSOEST=11
- ..S PSOERSTA=$S(PSOEST=3:"OH",PSOEST=12:"OD",PSOEST=15:"OD",1:"SC"),PSOPHSTA=$S(PSOEST=0:"CM",PSOEST=1:"IP",PSOEST=4:"IP",PSOEST=5:"ZS",PSOEST=11:"ZE",1:"")
- ..D EN^PSOHLSN1(PSOPPQZ,PSOERSTA,PSOPHSTA,"")
- .S $P(^PS(55,ZDFN,0),"^",6)=1
- D NOW^%DTC S $P(^PS(59.7,1,49.99),"^",9)=%
- S ZTREQ="@"
- Q
- PAT ;Check for correct patient
- S PTFLAG=0
- Q:ZDFN=$P($G(^PSRX(PSOPPQZ,0)),"^",2)
- S PTFLAG=1
- K ^PS(55,ZDFN,"P","A",PSOPPZ,PSOPPQZ)
- F III=0:0 S III=$O(^PS(55,ZDFN,"P",III)) Q:'III I $G(^PS(55,ZDFN,"P",III,0))=PSOPPQZ K ^PS(55,ZDFN,"P",III,0)
- Q
- PSOHLUP1 ;BIR/RTR-Backfill OERR from Pharmacy (all) ; 7/20/96
- +1 ;;7.0;OUTPATIENT PHARMACY;**10**;DEC 1997
- +2 ;
- +3 ;Backfill all Rx's
- EN ;
- +1 DO NOW^%DTC
- SET $PIECE(^PS(59.7,1,49.99),"^",8)=%
- +2 NEW C,Y,DA,IFN,RXP,DFN,PAT,PSODFN,PSOPPZ,PSOPPQZ,YEAR1,PSOEST,PSOERSTA,PSOPHSTA,X,T,PRU,PSOCV,PTFLAG,III,ZDFN
- +3 IF '$GET(DT)
- SET DT=$$DT^XLFDT
- +4 SET X1=DT
- SET X2=-121
- DO C^%DTC
- SET YEAR1=X
- +5 FOR ZDFN=0:0
- SET ZDFN=$ORDER(^PS(55,ZDFN))
- IF 'ZDFN
- QUIT
- IF '$PIECE($GET(^PS(55,ZDFN,0)),"^",6)
- Begin DoDot:1
- +6 FOR PSOPPZ=YEAR1:0
- SET PSOPPZ=$ORDER(^PS(55,ZDFN,"P","A",PSOPPZ))
- IF 'PSOPPZ
- QUIT
- FOR PSOPPQZ=0:0
- SET PSOPPQZ=$ORDER(^PS(55,ZDFN,"P","A",PSOPPZ,PSOPPQZ))
- IF 'PSOPPQZ
- QUIT
- DO PAT
- IF $DATA(^PSRX(PSOPPQZ,0))&('$PIECE($GET(^PSRX(PSOPPQZ,"OR1")),"^",2))&('$GET(PTFLAG))
- Begin DoDot:2
- +7 IF '$PIECE($GET(^PSRX(PSOPPQZ,0)),"^",2)
- QUIT
- +8 SET PSOEST=$SELECT($DATA(^PSRX(PSOPPQZ,"STA")):$PIECE($GET(^PSRX(PSOPPQZ,"STA")),"^"),1:$PIECE($GET(^PSRX(PSOPPQZ,0)),"^",15))
- IF PSOEST=10!(PSOEST=13)!(PSOEST=16)!(PSOEST=14)
- QUIT
- +9 IF '$PIECE($GET(^PSRX(PSOPPQZ,0)),"^",19)
- Begin DoDot:3
- +10 IF $PIECE($GET(^PSRX(PSOPPQZ,"OR1")),"^")']""
- IF +$GET(^PSDRUG(+$PIECE(^PSRX(PSOPPQZ,0),"^",6),2))
- SET $PIECE(^PSRX(PSOPPQZ,"OR1"),"^")=+$GET(^PSDRUG($PIECE(^PSRX(PSOPPQZ,0),"^",6),2))
- +11 IF $GET(^PSRX(PSOPPQZ,"SIG"))']""
- SET ^PSRX(PSOPPQZ,"SIG")=$PIECE($GET(^PSRX(PSOPPQZ,0)),"^",10)_"^"_0
- SET $PIECE(^PSRX(PSOPPQZ,0),"^",10)=""
- +12 SET ^PSRX(PSOPPQZ,"STA")=$PIECE($GET(^PSRX(PSOPPQZ,0)),"^",15)
- SET $PIECE(^PSRX(PSOPPQZ,0),"^",15)=""
- +13 SET PR=0
- FOR
- SET PR=$ORDER(^PSRX(PSOPPQZ,"P",PR))
- IF 'PR
- QUIT
- Begin DoDot:4
- +14 IF '$PIECE($GET(^PSRX(PSOPPQZ,"P",PR,0)),"^")
- KILL ^PSRX(PSOPPQZ,"P",PR,0)
- QUIT
- +15 SET ^PSRX("ADP",$EXTRACT($PIECE(^PSRX(PSOPPQZ,"P",PR,0),"^"),1,7),PSOPPQZ,PR)=""
- End DoDot:4
- +16 SET $PIECE(^PSRX(PSOPPQZ,0),"^",19)=1
- End DoDot:3
- +17 IF '$PIECE($GET(^PSRX(PSOPPQZ,"SIG")),"^",2)
- DO POP^PSOSIGNO(PSOPPQZ)
- +18 DO EN^PSOHLSN1(PSOPPQZ,"ZC","")
- +19 IF '$PIECE($GET(^PSRX(PSOPPQZ,"OR1")),"^",2)
- QUIT
- +20 SET PSOEST=$PIECE($GET(^PSRX(PSOPPQZ,"STA")),"^")
- +21 IF +$PIECE($GET(^PSRX(PSOPPQZ,2)),"^",6)
- IF $PIECE($GET(^(2)),"^",6)<DT
- SET $PIECE(^PSRX(PSOPPQZ,"STA"),"^")=11
- DO ECAN^PSOUTL(PSOPPQZ)
- SET PSOEST=11
- +22 SET PSOERSTA=$SELECT(PSOEST=3:"OH",PSOEST=12:"OD",PSOEST=15:"OD",1:"SC")
- SET PSOPHSTA=$SELECT(PSOEST=0:"CM",PSOEST=1:"IP",PSOEST=4:"IP",PSOEST=5:"ZS",PSOEST=11:"ZE",1:"")
- +23 DO EN^PSOHLSN1(PSOPPQZ,PSOERSTA,PSOPHSTA,"")
- End DoDot:2
- +24 SET $PIECE(^PS(55,ZDFN,0),"^",6)=1
- End DoDot:1
- +25 DO NOW^%DTC
- SET $PIECE(^PS(59.7,1,49.99),"^",9)=%
- +26 SET ZTREQ="@"
- +27 QUIT
- PAT ;Check for correct patient
- +1 SET PTFLAG=0
- +2 IF ZDFN=$PIECE($GET(^PSRX(PSOPPQZ,0)),"^",2)
- QUIT
- +3 SET PTFLAG=1
- +4 KILL ^PS(55,ZDFN,"P","A",PSOPPZ,PSOPPQZ)
- +5 FOR III=0:0
- SET III=$ORDER(^PS(55,ZDFN,"P",III))
- IF 'III
- QUIT
- IF $GET(^PS(55,ZDFN,"P",III,0))=PSOPPQZ
- KILL ^PS(55,ZDFN,"P",III,0)
- +6 QUIT
