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 Dec 13, 2024@02:23:05 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
