PSSPO129 ;BIR/RTR-POST INIT FOR PATCH PSS*1*129 ;06/14/07
;;1.0;PHARMACY DATA MANAGEMENT;**129**;9/30/97;Build 67
;
N PSSFACC,PSSFACCX
K PSSFACC,PSSFACCX
S PSSFACC("RD")="Pp" D FILESEC^DDMOD(51.23,.PSSFACC,"PSSFACCX") K PSSFACC,PSSFACCX
S PSSFACC("RD")="Pp" D FILESEC^DDMOD(51.24,.PSSFACC,"PSSFACCX") K PSSFACC,PSSFACCX
I $T(GETIEN^HDISVF09)]"",$T(EN^HDISVCMR)]"" D BMES^XPDUTL("Initializing standardization of Standard Medication Routes....") D ST D BMES^XPDUTL("Standardization Initialization complete.")
D BMES^XPDUTL("Rebuilding Pharmacy Data Managent Menus....") D BLD D BMES^XPDUTL("Rebuilding menus complete.")
D BMES^XPDUTL("Importing Dosage Form File Data....") D DS D BMES^XPDUTL("Importing data complete.")
D BMES^XPDUTL("Mapping Local Medication Routes....") D MEDRT D BMES^XPDUTL("Mapping Medication Routes complete.")
D BMES^XPDUTL("Mapping Local Possible Dosages....") D EN^PSSDSPOP D BMES^XPDUTL("Mapping Local Possible Dosages complete.")
D BMES^XPDUTL("Generating Mail Message....") D MAIL D BMES^XPDUTL("Mail message sent.")
Q
;
;
MAIL ;Find IV Solutions with Print Name 2 and Use in IV Fluid Order Entrt, and send mail message
;N PSSFVNMX,PSSFVNMZ,PSSFDFLG,PSSFDPRI,PSSFDUSE,PSSFDS,PSSFDCNT,PSSFDSOL,PSSFDNAM,XMTEXT,XMY,XMSUB,XMDUZ,XMMG,XMSTRIP,XMROU,XMDUN,XMYBLOB,XMZ
N PSSFDS,XMTEXT,XMY,XMSUB,XMDUZ,XMMG,XMSTRIP,XMROU,XMYBLOB,XMZ
K ^TMP($J,"PSSFDSXX")
;S ^TMP($J,"PSSFDSXX",1,0)="The following entries in the IV SOLUTIONS (#52.7) File have"
;S ^TMP($J,"PSSFDSXX",2,0)="data in the PRINT NAME {2} (#.02) Field and also have the USED"
;S ^TMP($J,"PSSFDSXX",3,0)="IN IV FLUID ORDER ENTRY (#17) Field set to 'YES'. This can"
;S ^TMP($J,"PSSFDSXX",4,0)="potentially cause confusion, please review and correct."
;S ^TMP($J,"PSSFDSXX",5,0)=" "
;S PSSFDCNT=6
;S PSSFDFLG=0
;S PSSFDNAM="" F S PSSFDNAM=$O(^PS(52.7,"B",PSSFDNAM)) Q:PSSFDNAM="" F PSSFDSOL=0:0 S PSSFDSOL=$O(^PS(52.7,"B",PSSFDNAM,PSSFDSOL)) Q:'PSSFDSOL D
;.S PSSFDPRI=$P($G(^PS(52.7,PSSFDSOL,0)),"^",4),PSSFDUSE=$P($G(^PS(52.7,PSSFDSOL,0)),"^",13)
;.I PSSFDPRI'="",$G(PSSFDUSE) D
;..S PSSFDFLG=1
;..S PSSFVNMX=$L($P($G(^PS(52.7,PSSFDSOL,0)),"^")) K PSSFVNMZ S $P(PSSFVNMZ," ",(34-PSSFVNMX))=""
;..S ^TMP($J,"PSSFDSXX",PSSFDCNT,0)=$P($G(^PS(52.7,PSSFDSOL,0)),"^")_PSSFVNMZ_"Volume: "_$P($G(^PS(52.7,PSSFDSOL,0)),"^",3)
;..S PSSFDCNT=PSSFDCNT+1
;I 'PSSFDFLG S ^TMP($J,"PSSFDSXX",PSSFDCNT,0)="No IV Solutions found."
;S PSSFDCNT=PSSFDCNT+1
;S ^TMP($J,"PSSFDSXX",PSSFDCNT,0)=" "
;S PSSFDCNT=PSSFDCNT+1
;S ^TMP($J,"PSSFDSXX",PSSFDCNT,0)="The Installation of patch PSS*1.0*129 is complete."
S ^TMP($J,"PSSFDSXX",1,0)="The Installation of patch PSS*1.0*129 is complete."
S XMSUB="PSS*1*129 Installation Complete"
S XMDUZ="PSS*1*129 Install"
S XMTEXT="^TMP($J,""PSSFDSXX"","
F PSSFDS=0:0 S PSSFDS=$O(@XPDGREF@("PSSVJARX",PSSFDS)) Q:'PSSFDS S XMY(PSSFDS)=""
N DIFROM D ^XMD
K ^TMP($J,"PSSFDSXX")
Q
;
;
ST ;Seed VUID data In Standard Medication Routes File (#51.23)
N PSSDOM,PSSDOMX
S PSSDOMX=$$GETIEN^HDISVF09("PHARMACY DATA MANAGEMENT",.PSSDOM)
I PSSDOMX D EN^HDISVCMR(PSSDOM,51.23)
Q
;
;
BLD ;Remove menu items from PSS MGR that were placed under other sub-menus
N PSSREMOV,PSSREMRS
F PSSREMOV="PSS MEDICATION ROUTES EDIT","PSS ORDERABLE ITEM REPORT","PSS EDIT TEXT","PSS DRUG TEXT FILE REPORT","PSS SCHEDULE EDIT","PSSJU MI" D
.S PSSREMRS=$$DELETE^XPDMENU("PSS MGR",PSSREMOV)
Q
;
;
DS ;Import Exclude From Dosage Checks field in Dosage Form File
N PSSFDD,PSSFDX
F PSSFDD=0:0 S PSSFDD=$O(@XPDGREF@("PSSVJDD",PSSFDD)) Q:'PSSFDD S $P(^PS(50.606,PSSFDD,1),"^")=@XPDGREF@("PSSVJDD",PSSFDD)
Q
;
;
MEDRT ;Populate FirstDataBank Med Route in File 51.2
;Will XTID screen work, right after the HD calls. (are the HD calls real-time?)
N PSSRTIEN,PSSRTNAM,PSSRTSTS,PSSRTIX
S PSSRTIX="" F S PSSRTIX=$O(^PS(51.2,"B",PSSRTIX)) Q:PSSRTIX="" D
.F PSSRTIEN=0:0 S PSSRTIEN=$O(^PS(51.2,"B",PSSRTIX,PSSRTIEN)) Q:'PSSRTIEN D
..I '$D(^PS(51.2,PSSRTIEN,0)) Q
..I '$P($G(^PS(51.2,PSSRTIEN,0)),"^",4) Q
..I $P($G(^PS(51.2,PSSRTIEN,1)),"^") Q
..L +^PS(51.2,PSSRTIEN):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I '$T Q
..K PSSRTNAM,PSSRTSTS
..S PSSRTNAM=$P($G(^PS(51.2,PSSRTIEN,0)),"^") S PSSRTNAM=$$UP^XLFSTR(PSSRTNAM)
..S PSSRTSTS=$O(^PS(51.23,"B",PSSRTNAM,0)) I PSSRTSTS,'$$SCREEN^XTID(51.23,.01,PSSRTSTS_",") D SET D UN Q
..K PSSRTSTS S PSSRTSTS=$O(^PS(51.23,"C",PSSRTNAM,0)) I PSSRTSTS,'$$SCREEN^XTID(51.23,.01,PSSRTSTS_",") D SET D UN Q
..K PSSRTSTS I PSSRTNAM[" EAR" S PSSRTSTS=$O(^PS(51.23,"B","OTIC",0)) I PSSRTSTS,'$$SCREEN^XTID(51.23,.01,PSSRTSTS_",") D SET D UN Q
..K PSSRTSTS I PSSRTNAM[" EYE" S PSSRTSTS=$O(^PS(51.23,"B","OPHTHALMIC",0)) I PSSRTSTS,'$$SCREEN^XTID(51.23,.01,PSSRTSTS_",") D SET D UN Q
..K PSSRTSTS I PSSRTNAM="G TUBE"!(PSSRTNAM="G-TUBE")!(PSSRTNAM="J TUBE")!(PSSRTNAM="J-TUBE")!(PSSRTNAM="NG TUBE")!(PSSRTNAM="NG-TUBE")!(PSSRTNAM="BY MOUTH") D I PSSRTSTS,'$$SCREEN^XTID(51.23,.01,PSSRTSTS_",") D SET D UN Q
...S PSSRTSTS=$O(^PS(51.23,"B","ORAL",0))
..K PSSRTSTS I PSSRTNAM["NOSE"!(PSSRTNAM["NASAL")!(PSSRTNAM["NOSTRIL") S PSSRTSTS=$O(^PS(51.23,"B","NASAL",0)) I PSSRTSTS,'$$SCREEN^XTID(51.23,.01,PSSRTSTS_",") D SET D UN Q
..K PSSRTSTS I PSSRTNAM="IVPB"!(PSSRTNAM="IV PUSH")!(PSSRTNAM="IV PIGGYBACK") S PSSRTSTS=$O(^PS(51.23,"B","INTRAVENOUS",0)) I PSSRTSTS,'$$SCREEN^XTID(51.23,.01,PSSRTSTS_",") D SET D UN Q
..D UN
Q
;
;
UN ;Unlock Med Route
L -^PS(51.2,PSSRTIEN)
Q
;
;
SET ;Set Data, leaving USER as null, so the installer is not recorded as the user
N %,PSSHASHP,X,%H,%I
K PSSHASHP
S $P(^PS(51.2,PSSRTIEN,1),"^")=PSSRTSTS
D NOW^%DTC S PSSHASHP(51.27,"+1,"_PSSRTIEN_",",.01)=%
S PSSHASHP(51.27,"+1,"_PSSRTIEN_",",1)=""
S PSSHASHP(51.27,"+1,"_PSSRTIEN_",",2)=""
S PSSHASHP(51.27,"+1,"_PSSRTIEN_",",3)=PSSRTSTS
D UPDATE^DIE("","PSSHASHP")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSPO129 5919 printed Apr 09, 2024@21:36:13 Page 2
PSSPO129 ;BIR/RTR-POST INIT FOR PATCH PSS*1*129 ;06/14/07
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**129**;9/30/97;Build 67
+2 ;
+3 NEW PSSFACC,PSSFACCX
+4 KILL PSSFACC,PSSFACCX
+5 SET PSSFACC("RD")="Pp"
DO FILESEC^DDMOD(51.23,.PSSFACC,"PSSFACCX")
KILL PSSFACC,PSSFACCX
+6 SET PSSFACC("RD")="Pp"
DO FILESEC^DDMOD(51.24,.PSSFACC,"PSSFACCX")
KILL PSSFACC,PSSFACCX
+7 IF $TEXT(GETIEN^HDISVF09)]""
IF $TEXT(EN^HDISVCMR)]""
DO BMES^XPDUTL("Initializing standardization of Standard Medication Routes....")
DO ST
DO BMES^XPDUTL("Standardization Initialization complete.")
+8 DO BMES^XPDUTL("Rebuilding Pharmacy Data Managent Menus....")
DO BLD
DO BMES^XPDUTL("Rebuilding menus complete.")
+9 DO BMES^XPDUTL("Importing Dosage Form File Data....")
DO DS
DO BMES^XPDUTL("Importing data complete.")
+10 DO BMES^XPDUTL("Mapping Local Medication Routes....")
DO MEDRT
DO BMES^XPDUTL("Mapping Medication Routes complete.")
+11 DO BMES^XPDUTL("Mapping Local Possible Dosages....")
DO EN^PSSDSPOP
DO BMES^XPDUTL("Mapping Local Possible Dosages complete.")
+12 DO BMES^XPDUTL("Generating Mail Message....")
DO MAIL
DO BMES^XPDUTL("Mail message sent.")
+13 QUIT
+14 ;
+15 ;
MAIL ;Find IV Solutions with Print Name 2 and Use in IV Fluid Order Entrt, and send mail message
+1 ;N PSSFVNMX,PSSFVNMZ,PSSFDFLG,PSSFDPRI,PSSFDUSE,PSSFDS,PSSFDCNT,PSSFDSOL,PSSFDNAM,XMTEXT,XMY,XMSUB,XMDUZ,XMMG,XMSTRIP,XMROU,XMDUN,XMYBLOB,XMZ
+2 NEW PSSFDS,XMTEXT,XMY,XMSUB,XMDUZ,XMMG,XMSTRIP,XMROU,XMYBLOB,XMZ
+3 KILL ^TMP($JOB,"PSSFDSXX")
+4 ;S ^TMP($J,"PSSFDSXX",1,0)="The following entries in the IV SOLUTIONS (#52.7) File have"
+5 ;S ^TMP($J,"PSSFDSXX",2,0)="data in the PRINT NAME {2} (#.02) Field and also have the USED"
+6 ;S ^TMP($J,"PSSFDSXX",3,0)="IN IV FLUID ORDER ENTRY (#17) Field set to 'YES'. This can"
+7 ;S ^TMP($J,"PSSFDSXX",4,0)="potentially cause confusion, please review and correct."
+8 ;S ^TMP($J,"PSSFDSXX",5,0)=" "
+9 ;S PSSFDCNT=6
+10 ;S PSSFDFLG=0
+11 ;S PSSFDNAM="" F S PSSFDNAM=$O(^PS(52.7,"B",PSSFDNAM)) Q:PSSFDNAM="" F PSSFDSOL=0:0 S PSSFDSOL=$O(^PS(52.7,"B",PSSFDNAM,PSSFDSOL)) Q:'PSSFDSOL D
+12 ;.S PSSFDPRI=$P($G(^PS(52.7,PSSFDSOL,0)),"^",4),PSSFDUSE=$P($G(^PS(52.7,PSSFDSOL,0)),"^",13)
+13 ;.I PSSFDPRI'="",$G(PSSFDUSE) D
+14 ;..S PSSFDFLG=1
+15 ;..S PSSFVNMX=$L($P($G(^PS(52.7,PSSFDSOL,0)),"^")) K PSSFVNMZ S $P(PSSFVNMZ," ",(34-PSSFVNMX))=""
+16 ;..S ^TMP($J,"PSSFDSXX",PSSFDCNT,0)=$P($G(^PS(52.7,PSSFDSOL,0)),"^")_PSSFVNMZ_"Volume: "_$P($G(^PS(52.7,PSSFDSOL,0)),"^",3)
+17 ;..S PSSFDCNT=PSSFDCNT+1
+18 ;I 'PSSFDFLG S ^TMP($J,"PSSFDSXX",PSSFDCNT,0)="No IV Solutions found."
+19 ;S PSSFDCNT=PSSFDCNT+1
+20 ;S ^TMP($J,"PSSFDSXX",PSSFDCNT,0)=" "
+21 ;S PSSFDCNT=PSSFDCNT+1
+22 ;S ^TMP($J,"PSSFDSXX",PSSFDCNT,0)="The Installation of patch PSS*1.0*129 is complete."
+23 SET ^TMP($JOB,"PSSFDSXX",1,0)="The Installation of patch PSS*1.0*129 is complete."
+24 SET XMSUB="PSS*1*129 Installation Complete"
+25 SET XMDUZ="PSS*1*129 Install"
+26 SET XMTEXT="^TMP($J,""PSSFDSXX"","
+27 FOR PSSFDS=0:0
SET PSSFDS=$ORDER(@XPDGREF@("PSSVJARX",PSSFDS))
if 'PSSFDS
QUIT
SET XMY(PSSFDS)=""
+28 NEW DIFROM
DO ^XMD
+29 KILL ^TMP($JOB,"PSSFDSXX")
+30 QUIT
+31 ;
+32 ;
ST ;Seed VUID data In Standard Medication Routes File (#51.23)
+1 NEW PSSDOM,PSSDOMX
+2 SET PSSDOMX=$$GETIEN^HDISVF09("PHARMACY DATA MANAGEMENT",.PSSDOM)
+3 IF PSSDOMX
DO EN^HDISVCMR(PSSDOM,51.23)
+4 QUIT
+5 ;
+6 ;
BLD ;Remove menu items from PSS MGR that were placed under other sub-menus
+1 NEW PSSREMOV,PSSREMRS
+2 FOR PSSREMOV="PSS MEDICATION ROUTES EDIT","PSS ORDERABLE ITEM REPORT","PSS EDIT TEXT","PSS DRUG TEXT FILE REPORT","PSS SCHEDULE EDIT","PSSJU MI"
Begin DoDot:1
+3 SET PSSREMRS=$$DELETE^XPDMENU("PSS MGR",PSSREMOV)
End DoDot:1
+4 QUIT
+5 ;
+6 ;
DS ;Import Exclude From Dosage Checks field in Dosage Form File
+1 NEW PSSFDD,PSSFDX
+2 FOR PSSFDD=0:0
SET PSSFDD=$ORDER(@XPDGREF@("PSSVJDD",PSSFDD))
if 'PSSFDD
QUIT
SET $PIECE(^PS(50.606,PSSFDD,1),"^")=@XPDGREF@("PSSVJDD",PSSFDD)
+3 QUIT
+4 ;
+5 ;
MEDRT ;Populate FirstDataBank Med Route in File 51.2
+1 ;Will XTID screen work, right after the HD calls. (are the HD calls real-time?)
+2 NEW PSSRTIEN,PSSRTNAM,PSSRTSTS,PSSRTIX
+3 SET PSSRTIX=""
FOR
SET PSSRTIX=$ORDER(^PS(51.2,"B",PSSRTIX))
if PSSRTIX=""
QUIT
Begin DoDot:1
+4 FOR PSSRTIEN=0:0
SET PSSRTIEN=$ORDER(^PS(51.2,"B",PSSRTIX,PSSRTIEN))
if 'PSSRTIEN
QUIT
Begin DoDot:2
+5 IF '$DATA(^PS(51.2,PSSRTIEN,0))
QUIT
+6 IF '$PIECE($GET(^PS(51.2,PSSRTIEN,0)),"^",4)
QUIT
+7 IF $PIECE($GET(^PS(51.2,PSSRTIEN,1)),"^")
QUIT
+8 LOCK +^PS(51.2,PSSRTIEN):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)
IF '$TEST
QUIT
+9 KILL PSSRTNAM,PSSRTSTS
+10 SET PSSRTNAM=$PIECE($GET(^PS(51.2,PSSRTIEN,0)),"^")
SET PSSRTNAM=$$UP^XLFSTR(PSSRTNAM)
+11 SET PSSRTSTS=$ORDER(^PS(51.23,"B",PSSRTNAM,0))
IF PSSRTSTS
IF '$$SCREEN^XTID(51.23,.01,PSSRTSTS_",")
DO SET
DO UN
QUIT
+12 KILL PSSRTSTS
SET PSSRTSTS=$ORDER(^PS(51.23,"C",PSSRTNAM,0))
IF PSSRTSTS
IF '$$SCREEN^XTID(51.23,.01,PSSRTSTS_",")
DO SET
DO UN
QUIT
+13 KILL PSSRTSTS
IF PSSRTNAM[" EAR"
SET PSSRTSTS=$ORDER(^PS(51.23,"B","OTIC",0))
IF PSSRTSTS
IF '$$SCREEN^XTID(51.23,.01,PSSRTSTS_",")
DO SET
DO UN
QUIT
+14 KILL PSSRTSTS
IF PSSRTNAM[" EYE"
SET PSSRTSTS=$ORDER(^PS(51.23,"B","OPHTHALMIC",0))
IF PSSRTSTS
IF '$$SCREEN^XTID(51.23,.01,PSSRTSTS_",")
DO SET
DO UN
QUIT
+15 KILL PSSRTSTS
IF PSSRTNAM="G TUBE"!(PSSRTNAM="G-TUBE")!(PSSRTNAM="J TUBE")!(PSSRTNAM="J-TUBE")!(PSSRTNAM="NG TUBE")!(PSSRTNAM="NG-TUBE")!(PSSRTNAM="BY MOUTH")
Begin DoDot:3
+16 SET PSSRTSTS=$ORDER(^PS(51.23,"B","ORAL",0))
End DoDot:3
IF PSSRTSTS
IF '$$SCREEN^XTID(51.23,.01,PSSRTSTS_",")
DO SET
DO UN
QUIT
+17 KILL PSSRTSTS
IF PSSRTNAM["NOSE"!(PSSRTNAM["NASAL")!(PSSRTNAM["NOSTRIL")
SET PSSRTSTS=$ORDER(^PS(51.23,"B","NASAL",0))
IF PSSRTSTS
IF '$$SCREEN^XTID(51.23,.01,PSSRTSTS_",")
DO SET
DO UN
QUIT
+18 KILL PSSRTSTS
IF PSSRTNAM="IVPB"!(PSSRTNAM="IV PUSH")!(PSSRTNAM="IV PIGGYBACK")
SET PSSRTSTS=$ORDER(^PS(51.23,"B","INTRAVENOUS",0))
IF PSSRTSTS
IF '$$SCREEN^XTID(51.23,.01,PSSRTSTS_",")
DO SET
DO UN
QUIT
+19 DO UN
End DoDot:2
End DoDot:1
+20 QUIT
+21 ;
+22 ;
UN ;Unlock Med Route
+1 LOCK -^PS(51.2,PSSRTIEN)
+2 QUIT
+3 ;
+4 ;
SET ;Set Data, leaving USER as null, so the installer is not recorded as the user
+1 NEW %,PSSHASHP,X,%H,%I
+2 KILL PSSHASHP
+3 SET $PIECE(^PS(51.2,PSSRTIEN,1),"^")=PSSRTSTS
+4 DO NOW^%DTC
SET PSSHASHP(51.27,"+1,"_PSSRTIEN_",",.01)=%
+5 SET PSSHASHP(51.27,"+1,"_PSSRTIEN_",",1)=""
+6 SET PSSHASHP(51.27,"+1,"_PSSRTIEN_",",2)=""
+7 SET PSSHASHP(51.27,"+1,"_PSSRTIEN_",",3)=PSSRTSTS
+8 DO UPDATE^DIE("","PSSHASHP")
+9 QUIT
