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

PSO520PO.m

Go to the documentation of this file.
PSO520PO ;ALB/BLB - eRx utilities ; 3/29/2018 4:00pm
 ;;7.0;OUTPATIENT PHARMACY;**520**;DEC 1997;Build 52
 ;
 N EIEN,IENS,QIEN,ODOSORD,NEWDOSE,ONOUND,ODOSE,FDA,POO,POQIEN,POQIENS,PO,PODOSE,PONOUN,PODOSORD,DOSORD,ONOUN
 N PNEWDOSE,PFDA
 D EN^DDIOL("Correcting dosing data for inbound electronic prescriptions")
 D EN^DDIOL("and pending outpatient orders. Please be patient.")
 S EIEN=0 F  S EIEN=$O(^PS(52.49,EIEN)) Q:'EIEN  D
 .S QIEN=0 F  S QIEN=$O(^PS(52.49,EIEN,21,QIEN)) Q:'QIEN  D
 ..S IENS=QIEN_","_EIEN_","
 ..I $$GET1^DIQ(52.4921,IENS,.01)'="&" Q
 ..S ODOSORD=$$GET1^DIQ(52.4921,IENS,9,"E")
 ..S ODOSE=$$GET1^DIQ(52.4921,IENS,8,"E")
 ..S ONOUN=$$GET1^DIQ(52.4921,IENS,12,"E")
 ..I ODOSORD]"" S NEWDOSE=ODOSORD_"&"_ONOUN,FDA(52.4921,IENS,.01)=NEWDOSE D FILE^DIE(,"FDA") K FDA Q
 ..S NEWDOSE=ODOSE,FDA(52.4921,IENS,.01)=NEWDOSE D FILE^DIE(,"FDA") K FDA Q
 .S POO=$$GET1^DIQ(52.49,EIEN,25.2,"I") I 'POO Q
 .I '$D(^PS(52.41,POO)) Q
 .S POQIEN=0 F  S POQIEN=$O(^PS(52.41,POO,1,POQIEN)) Q:'POQIEN  D
 ..S POQIENS=POQIEN_","_POO_","
 ..I $$GET1^DIQ(52.413,POQIENS,.01)'="&" Q
 ..S PODOSORD=$$GET1^DIQ(52.413,POQIENS,9,"E")
 ..S PODOSE=$$GET1^DIQ(52.413,POQIENS,8,"E")
 ..S PONOUN=$$GET1^DIQ(52.413,POQIENS,12,"E")
 ..I PODOSORD]"" S PNEWDOSE=PODOSORD_"&"_PONOUN,PFDA(52.413,POQIENS,.01)=PNEWDOSE D FILE^DIE(,"PFDA") K PFDA Q
 ..S PNEWDOSE=PODOSE,PFDA(52.413,POQIENS,.01)=PNEWDOSE D FILE^DIE(,"PFDA") K PFDA Q
 D CLEANREC
 Q
CLEANREC ; 
 N EXIEN,FDA
 S EXIEN=0 F  S EXIEN=$O(^PS(52.49,EXIEN)) Q:'EXIEN  D
 .I '$$GET1^DIQ(52.49,EXIEN,2.1,"I"),$$GET1^DIQ(52.49,EXIEN,1,"E")="N" D
 ..S FDA(52.49,EXIEN_",",.01)="@" D FILE^DIE(,"FDA") K FDA
 Q