Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSO527PO

PSO527PO.m

Go to the documentation of this file.
  1. PSO527PO ;ALB/BLB - eRx utilities ; 5/03/2018 11:25am
  1. ;;7.0;OUTPATIENT PHARMACY;**527**;DEC 1997;Build 30
  1. ;
  1. N FDA,DIK,DRU02IEN
  1. S DRU02IEN=$$PRESOLV^PSOERXA1("DRU02","REJ")
  1. I DRU02IEN D
  1. .S FDA(52.45,DRU02IEN_",",.02)="Non-formulary drug"
  1. .D FILE^DIE(,"FDA") K FDA
  1. S DIK="^PS(52.49,",DIK(1)=".04^EPAT" D ENALL^DIK K DIK
  1. S DIK="^PS(52.49,",DIK(1)="2.1^EPROV" D ENALL^DIK K DIK
  1. I '$D(^PS(52.45,"C","ERX","W")) D
  1. .S FDA(52.45,"+1,",.01)="W"
  1. .S FDA(52.45,"+1,",.02)="WAIT"
  1. .S FDA(52.45,"+1,",.03)="ERX"
  1. .D UPDATE^DIE(,"FDA") K FDA
  1. UPSTATUS ;
  1. N BDATE,EDATE,RXDATE,RXSTAT,RXSTATE,ERXIEN,VALCNT,PSOINST
  1. S BDATE=$$FMADD^XLFDT(DT,-1000)
  1. S EDATE=DT_".9999"
  1. S PSOINST=0 F S PSOINST=$O(^PS(52.49,"F",PSOINST)) Q:'PSOINST D
  1. .S RXDATE=BDATE
  1. .F S RXDATE=$O(^PS(52.49,"F",PSOINST,RXDATE)) Q:'RXDATE!(RXDATE>EDATE)!(RXDATE="") D
  1. ..S RXSTAT=0 F S RXSTAT=$O(^PS(52.49,"F",PSOINST,RXDATE,RXSTAT)) Q:'RXSTAT D
  1. ...S RXSTATE=$$GET1^DIQ(52.45,RXSTAT,.01,"E")
  1. ...I ((RXSTATE="RJ")!(RXSTATE="RM")!(RXSTATE="PR")) Q
  1. ...S ERXIEN=0
  1. ...F S ERXIEN=$O(^PS(52.49,"F",PSOINST,RXDATE,RXSTAT,ERXIEN)) Q:'ERXIEN D
  1. ....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
  1. .....D UPDSTAT^PSOERXU1(ERXIEN,"W")
  1. Q