PSS189PI ;BHAM-ISC/MFR - Post-install Routine for Patch PSS*1*189 ;07/26/06
;;1.0;PHARMACY DATA MANAGEMENT;**189**;9/30/97;Build 54
;
;Reference to ^PS(52.6 supported by DBIA #6338
;Reference to ^PS(52.7 supported by DBIA #6339
;
EN ; Environemnt Check Routine Entry Point
N MSGBODY
K ^TMP("PSS189PI",$J)
D UPDATE
D MSG(.MSGBODY)
I $O(^TMP("PSS189PI",$J,0)) D MAIL(.MSGBODY)
K ^TMP("PSS189PI",$J)
;
;Set up identifier for 52.6 field 12
;Set up identifier for 52.7 field 8
N TXT
S TXT="W:$G(^(""I"")) "" "",$E($P(^(""I""),U,1),4,5)_""-""_$E($P(^(""I""),U,1),6,7)_""-""_$E($P(^(""I""),U,1),2,3)"
S ^DD(52.6,0,"ID",12)=TXT ;IV Additives
S ^DD(52.7,0,"ID",8)=TXT ;IV Solutions
Q
;
UPDATE ; Updating the USED IN IV FLUID ORDER ENTRY field (Setting to 'NO' for no longer IV Solutions)
N OI,IVSOL,IVVOL,IVDRUG,OIINADT,DRGINADT,IVINADT
S IVSOL=0
F S IVSOL=$O(^PS(52.7,IVSOL)) Q:'IVSOL D
. ; Not used in the IV Dialog
. I '$$GET1^DIQ(52.7,IVSOL,17,"I") Q
. ; Pharmacy Orderable Item
. S OI=+$$GET1^DIQ(52.7,IVSOL,9,"I") I 'OI Q
. ; IV Dispense Drug
. S IVDRUG=$$GET1^DIQ(52.7,IVSOL,1,"I") I 'IVDRUG Q
. ; IV Solution IVVOL
. S IVVOL=$$GET1^DIQ(52.7,IVSOL,2) I IVVOL="" Q
. ; At least one of IV Solution OR Orderable Item OR Dispense Drug is INACTIVE
. S OIINADT=$$GET1^DIQ(50.7,OI,.04,"I"),DRGINADT=$$GET1^DIQ(50,IVDRUG,100,"I"),IVINADT=$$GET1^DIQ(52.7,IVSOL,8,"I")
. I (OIINADT&(OIINADT<DT))!(DRGINADT&(DRGINADT<DT))!(IVINADT&(IVINADT<DT)) D Q
. . ; Setting USED IN THE IV FLUID ORDER ENTRY field to 'NO'
. . S $P(^PS(52.7,IVSOL,0),"^",13)=0
. . S ^TMP("PSS189PI",$J,OI,IVDRUG,IVSOL)=IVVOL
Q
;
DUPSOL(OI,IVSOL,IVVOL,SKPIN) ; Check if there's a Duplicate IV Solution Marked to be Used in the IV Order Dialog
; Input: OI - PHARMACY ORDERABLE ITEM (#50.7) Pointer
; IVSOL - IV SOLUTIONS (#52.7) Pointer
; IVVOL - IV Solution Volume
; SKPIN - Skip Inactive? (1/0)
;Output: DUPSOL - Duplicate IV SOLUTION (#52.7) Pointer (if any)
;
N DUPSOL,OTHSOL,OTHVOL,OTHDRUG
S (DUPSOL,OTHSOL)=0
F S OTHSOL=$O(^PS(52.7,"AOI",OI,OTHSOL)) Q:'OTHSOL!DUPSOL D
. ; Cannot check against itself
. I (IVSOL=OTHSOL) Q
. ; Not Used in the IV Order Dialog
. I '$$GET1^DIQ(52.7,OTHSOL,17,"I") Q
. ; Other IV Solution is INACTIVE
. I SKPIN,$$GET1^DIQ(52.7,OTHSOL,8,"I"),$$GET1^DIQ(52.7,OTHSOL,8,"I")'>DT Q
. ; Other IV Dispense Drug
. S OTHDRUG=$$GET1^DIQ(52.7,OTHSOL,1,"I")
. ; Other Dispense Drug is INACTIVE
. I SKPIN,$$GET1^DIQ(50,OTHDRUG,100,"I"),$$GET1^DIQ(50,OTHDRUG,100,"I")'>DT Q
. ; IV Solution Volume
. S OTHVOL=$$GET1^DIQ(52.7,OTHSOL,2)
. ; IV Solutions have different volumes
. I (IVVOL'=OTHVOL) Q
. ; Capturing the IV Solutions with issues
. S DUPSOL=OTHSOL
Q DUPSOL
;
MSG(MSGBODY) ; Creating the Mailman Message body
N LN,OI,IVDRUG,IVSOL,DUPVOL
D ADDLINE(.MSGBODY,"The list below shows IV Solutions in your database that had the field")
D ADDLINE(.MSGBODY,"USED IN IV FLUID ORDER ENTRY set to 'NO' because either the Orderable")
D ADDLINE(.MSGBODY,"Item, the Dispense Drug or the IV Solution itself was marked INACTIVE.")
D ADDLINE(.MSGBODY,"")
;
D ADDLINE(.MSGBODY,"Run Date/Time: "_$$FMTE^XLFDT($$NOW^XLFDT))
S $P(LN,"-",80)="" D ADDLINE(.MSGBODY,LN)
D ADDLINE(.MSGBODY,"ORDERABLE ITEM (IEN)")
S LN=" IV DISPENSE DRUG (IEN)" D ADDLINE(.MSGBODY,LN)
S LN=" IV SOLUTION (IEN/VOLUME)" D ADDLINE(.MSGBODY,LN)
S LN="",$P(LN,"-",80)="" D ADDLINE(.MSGBODY,LN)
;
S (OI,IVDRUG,IVSOL)=""
F S OI=$O(^TMP("PSS189PI",$J,OI)) Q:'OI D
. D ADDLINE(.MSGBODY,$$GET1^DIQ(50.7,OI,.01)_" ("_OI_")"_$S($$GET1^DIQ(50.7,OI,.04,"I"):" *** INACTIVE DATE: "_$$GET1^DIQ(50.7,OI,.04)_" ***",1:""))
. F S IVDRUG=$O(^TMP("PSS189PI",$J,OI,IVDRUG)) Q:'IVDRUG D
. . S LN=" "_$$GET1^DIQ(50,+IVDRUG,.01)_" ("_+IVDRUG_")"_$S($$GET1^DIQ(50,IVDRUG,100,"I"):" *** INACTIVE DATE: "_$$GET1^DIQ(50,IVDRUG,100)_" ***",1:"")
. . D ADDLINE(.MSGBODY,LN)
. . F S IVSOL=$O(^TMP("PSS189PI",$J,OI,IVDRUG,IVSOL)) Q:'IVSOL D
. . . S DUPVOL=^TMP("PSS189PI",$J,OI,IVDRUG,IVSOL)
. . . S LN=" "_$$GET1^DIQ(52.7,+IVSOL,.01)_" ("_+IVSOL_"/"_DUPVOL_")"_$S($$GET1^DIQ(52.7,IVSOL,8,"I"):" *** INACTIVE DATE: "_$$GET1^DIQ(52.7,IVSOL,8)_" ***",1:"")
. . . D ADDLINE(.MSGBODY,LN)
. D ADDLINE(.MSGBODY,"")
Q
;
MAIL(MSGTEXT) ; Compose/Send the Mailman message
N XMDUZ,XMSUB,XMY,XMTEXT,RECPT,SECKEY,DIFROM
S XMDUZ="Patch PSS*1*189",XMSUB="Auto-update of the IV Solution file"
;
; Sending the message to the holders of the PSIVMGR, PSJI MGR and PSNMGR security key + Patch installer
F SECKEY="PSIVMGR","PSJI MGR","PSNMGR" D
. S RECPT=0 F S RECPT=$O(^XUSEC(SECKEY,RECPT)) Q:'RECPT S XMY(RECPT)=""
S XMY(DUZ)=""
S XMTEXT="MSGTEXT(" D ^XMD
Q
;
ADDLINE(MSG,TXT) ; Adds a line to the Mailman Message Text
N LINE
S LINE=$O(MSG(99999),-1)+1,MSG(LINE)=TXT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSS189PI 4939 printed Dec 13, 2024@02:29:19 Page 2
PSS189PI ;BHAM-ISC/MFR - Post-install Routine for Patch PSS*1*189 ;07/26/06
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**189**;9/30/97;Build 54
+2 ;
+3 ;Reference to ^PS(52.6 supported by DBIA #6338
+4 ;Reference to ^PS(52.7 supported by DBIA #6339
+5 ;
EN ; Environemnt Check Routine Entry Point
+1 NEW MSGBODY
+2 KILL ^TMP("PSS189PI",$JOB)
+3 DO UPDATE
+4 DO MSG(.MSGBODY)
+5 IF $ORDER(^TMP("PSS189PI",$JOB,0))
DO MAIL(.MSGBODY)
+6 KILL ^TMP("PSS189PI",$JOB)
+7 ;
+8 ;Set up identifier for 52.6 field 12
+9 ;Set up identifier for 52.7 field 8
+10 NEW TXT
+11 SET TXT="W:$G(^(""I"")) "" "",$E($P(^(""I""),U,1),4,5)_""-""_$E($P(^(""I""),U,1),6,7)_""-""_$E($P(^(""I""),U,1),2,3)"
+12 ;IV Additives
SET ^DD(52.6,0,"ID",12)=TXT
+13 ;IV Solutions
SET ^DD(52.7,0,"ID",8)=TXT
+14 QUIT
+15 ;
UPDATE ; Updating the USED IN IV FLUID ORDER ENTRY field (Setting to 'NO' for no longer IV Solutions)
+1 NEW OI,IVSOL,IVVOL,IVDRUG,OIINADT,DRGINADT,IVINADT
+2 SET IVSOL=0
+3 FOR
SET IVSOL=$ORDER(^PS(52.7,IVSOL))
if 'IVSOL
QUIT
Begin DoDot:1
+4 ; Not used in the IV Dialog
+5 IF '$$GET1^DIQ(52.7,IVSOL,17,"I")
QUIT
+6 ; Pharmacy Orderable Item
+7 SET OI=+$$GET1^DIQ(52.7,IVSOL,9,"I")
IF 'OI
QUIT
+8 ; IV Dispense Drug
+9 SET IVDRUG=$$GET1^DIQ(52.7,IVSOL,1,"I")
IF 'IVDRUG
QUIT
+10 ; IV Solution IVVOL
+11 SET IVVOL=$$GET1^DIQ(52.7,IVSOL,2)
IF IVVOL=""
QUIT
+12 ; At least one of IV Solution OR Orderable Item OR Dispense Drug is INACTIVE
+13 SET OIINADT=$$GET1^DIQ(50.7,OI,.04,"I")
SET DRGINADT=$$GET1^DIQ(50,IVDRUG,100,"I")
SET IVINADT=$$GET1^DIQ(52.7,IVSOL,8,"I")
+14 IF (OIINADT&(OIINADT<DT))!(DRGINADT&(DRGINADT<DT))!(IVINADT&(IVINADT<DT))
Begin DoDot:2
+15 ; Setting USED IN THE IV FLUID ORDER ENTRY field to 'NO'
+16 SET $PIECE(^PS(52.7,IVSOL,0),"^",13)=0
+17 SET ^TMP("PSS189PI",$JOB,OI,IVDRUG,IVSOL)=IVVOL
End DoDot:2
QUIT
End DoDot:1
+18 QUIT
+19 ;
DUPSOL(OI,IVSOL,IVVOL,SKPIN) ; Check if there's a Duplicate IV Solution Marked to be Used in the IV Order Dialog
+1 ; Input: OI - PHARMACY ORDERABLE ITEM (#50.7) Pointer
+2 ; IVSOL - IV SOLUTIONS (#52.7) Pointer
+3 ; IVVOL - IV Solution Volume
+4 ; SKPIN - Skip Inactive? (1/0)
+5 ;Output: DUPSOL - Duplicate IV SOLUTION (#52.7) Pointer (if any)
+6 ;
+7 NEW DUPSOL,OTHSOL,OTHVOL,OTHDRUG
+8 SET (DUPSOL,OTHSOL)=0
+9 FOR
SET OTHSOL=$ORDER(^PS(52.7,"AOI",OI,OTHSOL))
if 'OTHSOL!DUPSOL
QUIT
Begin DoDot:1
+10 ; Cannot check against itself
+11 IF (IVSOL=OTHSOL)
QUIT
+12 ; Not Used in the IV Order Dialog
+13 IF '$$GET1^DIQ(52.7,OTHSOL,17,"I")
QUIT
+14 ; Other IV Solution is INACTIVE
+15 IF SKPIN
IF $$GET1^DIQ(52.7,OTHSOL,8,"I")
IF $$GET1^DIQ(52.7,OTHSOL,8,"I")'>DT
QUIT
+16 ; Other IV Dispense Drug
+17 SET OTHDRUG=$$GET1^DIQ(52.7,OTHSOL,1,"I")
+18 ; Other Dispense Drug is INACTIVE
+19 IF SKPIN
IF $$GET1^DIQ(50,OTHDRUG,100,"I")
IF $$GET1^DIQ(50,OTHDRUG,100,"I")'>DT
QUIT
+20 ; IV Solution Volume
+21 SET OTHVOL=$$GET1^DIQ(52.7,OTHSOL,2)
+22 ; IV Solutions have different volumes
+23 IF (IVVOL'=OTHVOL)
QUIT
+24 ; Capturing the IV Solutions with issues
+25 SET DUPSOL=OTHSOL
End DoDot:1
+26 QUIT DUPSOL
+27 ;
MSG(MSGBODY) ; Creating the Mailman Message body
+1 NEW LN,OI,IVDRUG,IVSOL,DUPVOL
+2 DO ADDLINE(.MSGBODY,"The list below shows IV Solutions in your database that had the field")
+3 DO ADDLINE(.MSGBODY,"USED IN IV FLUID ORDER ENTRY set to 'NO' because either the Orderable")
+4 DO ADDLINE(.MSGBODY,"Item, the Dispense Drug or the IV Solution itself was marked INACTIVE.")
+5 DO ADDLINE(.MSGBODY,"")
+6 ;
+7 DO ADDLINE(.MSGBODY,"Run Date/Time: "_$$FMTE^XLFDT($$NOW^XLFDT))
+8 SET $PIECE(LN,"-",80)=""
DO ADDLINE(.MSGBODY,LN)
+9 DO ADDLINE(.MSGBODY,"ORDERABLE ITEM (IEN)")
+10 SET LN=" IV DISPENSE DRUG (IEN)"
DO ADDLINE(.MSGBODY,LN)
+11 SET LN=" IV SOLUTION (IEN/VOLUME)"
DO ADDLINE(.MSGBODY,LN)
+12 SET LN=""
SET $PIECE(LN,"-",80)=""
DO ADDLINE(.MSGBODY,LN)
+13 ;
+14 SET (OI,IVDRUG,IVSOL)=""
+15 FOR
SET OI=$ORDER(^TMP("PSS189PI",$JOB,OI))
if 'OI
QUIT
Begin DoDot:1
+16 DO ADDLINE(.MSGBODY,$$GET1^DIQ(50.7,OI,.01)_" ("_OI_")"_$SELECT($$GET1^DIQ(50.7,OI,.04,"I"):" *** INACTIVE DATE: "_$$GET1^DIQ(50.7,OI,.04)_" ***",1:""))
+17 FOR
SET IVDRUG=$ORDER(^TMP("PSS189PI",$JOB,OI,IVDRUG))
if 'IVDRUG
QUIT
Begin DoDot:2
+18 SET LN=" "_$$GET1^DIQ(50,+IVDRUG,.01)_" ("_+IVDRUG_")"_$SELECT($$GET1^DIQ(50,IVDRUG,100,"I"):" *** INACTIVE DATE: "_$$GET1^DIQ(50,IVDRUG,100)_" ***",1:"")
+19 DO ADDLINE(.MSGBODY,LN)
+20 FOR
SET IVSOL=$ORDER(^TMP("PSS189PI",$JOB,OI,IVDRUG,IVSOL))
if 'IVSOL
QUIT
Begin DoDot:3
+21 SET DUPVOL=^TMP("PSS189PI",$JOB,OI,IVDRUG,IVSOL)
+22 SET LN=" "_$$GET1^DIQ(52.7,+IVSOL,.01)_" ("_+IVSOL_"/"_DUPVOL_")"_$SELECT($$GET1^DIQ(52.7,IVSOL,8,"I"):" *** INACTIVE DATE: "_$$GET1^DIQ(52.7,IVSOL,8)_" ***",1:"")
+23 DO ADDLINE(.MSGBODY,LN)
End DoDot:3
End DoDot:2
+24 DO ADDLINE(.MSGBODY,"")
End DoDot:1
+25 QUIT
+26 ;
MAIL(MSGTEXT) ; Compose/Send the Mailman message
+1 NEW XMDUZ,XMSUB,XMY,XMTEXT,RECPT,SECKEY,DIFROM
+2 SET XMDUZ="Patch PSS*1*189"
SET XMSUB="Auto-update of the IV Solution file"
+3 ;
+4 ; Sending the message to the holders of the PSIVMGR, PSJI MGR and PSNMGR security key + Patch installer
+5 FOR SECKEY="PSIVMGR","PSJI MGR","PSNMGR"
Begin DoDot:1
+6 SET RECPT=0
FOR
SET RECPT=$ORDER(^XUSEC(SECKEY,RECPT))
if 'RECPT
QUIT
SET XMY(RECPT)=""
End DoDot:1
+7 SET XMY(DUZ)=""
+8 SET XMTEXT="MSGTEXT("
DO ^XMD
+9 QUIT
+10 ;
ADDLINE(MSG,TXT) ; Adds a line to the Mailman Message Text
+1 NEW LINE
+2 SET LINE=$ORDER(MSG(99999),-1)+1
SET MSG(LINE)=TXT
+3 QUIT
