- PSO527PO ;ALB/BLB - eRx utilities ; 5/03/2018 11:25am
- ;;7.0;OUTPATIENT PHARMACY;**527**;DEC 1997;Build 30
- ;
- N FDA,DIK,DRU02IEN
- S DRU02IEN=$$PRESOLV^PSOERXA1("DRU02","REJ")
- I DRU02IEN D
- .S FDA(52.45,DRU02IEN_",",.02)="Non-formulary drug"
- .D FILE^DIE(,"FDA") K FDA
- S DIK="^PS(52.49,",DIK(1)=".04^EPAT" D ENALL^DIK K DIK
- S DIK="^PS(52.49,",DIK(1)="2.1^EPROV" D ENALL^DIK K DIK
- I '$D(^PS(52.45,"C","ERX","W")) D
- .S FDA(52.45,"+1,",.01)="W"
- .S FDA(52.45,"+1,",.02)="WAIT"
- .S FDA(52.45,"+1,",.03)="ERX"
- .D UPDATE^DIE(,"FDA") K FDA
- UPSTATUS ;
- N BDATE,EDATE,RXDATE,RXSTAT,RXSTATE,ERXIEN,VALCNT,PSOINST
- S BDATE=$$FMADD^XLFDT(DT,-1000)
- S EDATE=DT_".9999"
- S PSOINST=0 F S PSOINST=$O(^PS(52.49,"F",PSOINST)) Q:'PSOINST D
- .S RXDATE=BDATE
- .F S RXDATE=$O(^PS(52.49,"F",PSOINST,RXDATE)) Q:'RXDATE!(RXDATE>EDATE)!(RXDATE="") D
- ..S RXSTAT=0 F S RXSTAT=$O(^PS(52.49,"F",PSOINST,RXDATE,RXSTAT)) Q:'RXSTAT D
- ...S RXSTATE=$$GET1^DIQ(52.45,RXSTAT,.01,"E")
- ...I ((RXSTATE="RJ")!(RXSTATE="RM")!(RXSTATE="PR")) Q
- ...S ERXIEN=0
- ...F S ERXIEN=$O(^PS(52.49,"F",PSOINST,RXDATE,RXSTAT,ERXIEN)) Q:'ERXIEN D
- ....I $$GET1^DIQ(52.49,ERXIEN,1.3,"I"),$$GET1^DIQ(52.49,ERXIEN,1.5,"I"),$$GET1^DIQ(52.49,ERXIEN,1.7,"I") D
- .....D UPDSTAT^PSOERXU1(ERXIEN,"W")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSO527PO 1286 printed Feb 18, 2025@23:49:24 Page 2
- PSO527PO ;ALB/BLB - eRx utilities ; 5/03/2018 11:25am
- +1 ;;7.0;OUTPATIENT PHARMACY;**527**;DEC 1997;Build 30
- +2 ;
- +3 NEW FDA,DIK,DRU02IEN
- +4 SET DRU02IEN=$$PRESOLV^PSOERXA1("DRU02","REJ")
- +5 IF DRU02IEN
- Begin DoDot:1
- +6 SET FDA(52.45,DRU02IEN_",",.02)="Non-formulary drug"
- +7 DO FILE^DIE(,"FDA")
- KILL FDA
- End DoDot:1
- +8 SET DIK="^PS(52.49,"
- SET DIK(1)=".04^EPAT"
- DO ENALL^DIK
- KILL DIK
- +9 SET DIK="^PS(52.49,"
- SET DIK(1)="2.1^EPROV"
- DO ENALL^DIK
- KILL DIK
- +10 IF '$DATA(^PS(52.45,"C","ERX","W"))
- Begin DoDot:1
- +11 SET FDA(52.45,"+1,",.01)="W"
- +12 SET FDA(52.45,"+1,",.02)="WAIT"
- +13 SET FDA(52.45,"+1,",.03)="ERX"
- +14 DO UPDATE^DIE(,"FDA")
- KILL FDA
- End DoDot:1
- UPSTATUS ;
- +1 NEW BDATE,EDATE,RXDATE,RXSTAT,RXSTATE,ERXIEN,VALCNT,PSOINST
- +2 SET BDATE=$$FMADD^XLFDT(DT,-1000)
- +3 SET EDATE=DT_".9999"
- +4 SET PSOINST=0
- FOR
- SET PSOINST=$ORDER(^PS(52.49,"F",PSOINST))
- if 'PSOINST
- QUIT
- Begin DoDot:1
- +5 SET RXDATE=BDATE
- +6 FOR
- SET RXDATE=$ORDER(^PS(52.49,"F",PSOINST,RXDATE))
- if 'RXDATE!(RXDATE>EDATE)!(RXDATE="")
- QUIT
- Begin DoDot:2
- +7 SET RXSTAT=0
- FOR
- SET RXSTAT=$ORDER(^PS(52.49,"F",PSOINST,RXDATE,RXSTAT))
- if 'RXSTAT
- QUIT
- Begin DoDot:3
- +8 SET RXSTATE=$$GET1^DIQ(52.45,RXSTAT,.01,"E")
- +9 IF ((RXSTATE="RJ")!(RXSTATE="RM")!(RXSTATE="PR"))
- QUIT
- +10 SET ERXIEN=0
- +11 FOR
- SET ERXIEN=$ORDER(^PS(52.49,"F",PSOINST,RXDATE,RXSTAT,ERXIEN))
- if 'ERXIEN
- QUIT
- Begin DoDot:4
- +12 IF $$GET1^DIQ(52.49,ERXIEN,1.3,"I")
- IF $$GET1^DIQ(52.49,ERXIEN,1.5,"I")
- IF $$GET1^DIQ(52.49,ERXIEN,1.7,"I")
- Begin DoDot:5
- +13 DO UPDSTAT^PSOERXU1(ERXIEN,"W")
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +14 QUIT