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

PSS189PI.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;Reference to ^PS(52.6 supported by DBIA #6338
  1. ;Reference to ^PS(52.7 supported by DBIA #6339
  1. ;
  1. EN ; Environemnt Check Routine Entry Point
  1. N MSGBODY
  1. K ^TMP("PSS189PI",$J)
  1. D UPDATE
  1. D MSG(.MSGBODY)
  1. I $O(^TMP("PSS189PI",$J,0)) D MAIL(.MSGBODY)
  1. K ^TMP("PSS189PI",$J)
  1. ;
  1. ;Set up identifier for 52.6 field 12
  1. ;Set up identifier for 52.7 field 8
  1. N TXT
  1. 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)"
  1. S ^DD(52.6,0,"ID",12)=TXT ;IV Additives
  1. S ^DD(52.7,0,"ID",8)=TXT ;IV Solutions
  1. Q
  1. ;
  1. UPDATE ; Updating the USED IN IV FLUID ORDER ENTRY field (Setting to 'NO' for no longer IV Solutions)
  1. N OI,IVSOL,IVVOL,IVDRUG,OIINADT,DRGINADT,IVINADT
  1. S IVSOL=0
  1. F S IVSOL=$O(^PS(52.7,IVSOL)) Q:'IVSOL D
  1. . ; Not used in the IV Dialog
  1. . I '$$GET1^DIQ(52.7,IVSOL,17,"I") Q
  1. . ; Pharmacy Orderable Item
  1. . S OI=+$$GET1^DIQ(52.7,IVSOL,9,"I") I 'OI Q
  1. . ; IV Dispense Drug
  1. . S IVDRUG=$$GET1^DIQ(52.7,IVSOL,1,"I") I 'IVDRUG Q
  1. . ; IV Solution IVVOL
  1. . S IVVOL=$$GET1^DIQ(52.7,IVSOL,2) I IVVOL="" Q
  1. . ; At least one of IV Solution OR Orderable Item OR Dispense Drug is INACTIVE
  1. . S OIINADT=$$GET1^DIQ(50.7,OI,.04,"I"),DRGINADT=$$GET1^DIQ(50,IVDRUG,100,"I"),IVINADT=$$GET1^DIQ(52.7,IVSOL,8,"I")
  1. . I (OIINADT&(OIINADT<DT))!(DRGINADT&(DRGINADT<DT))!(IVINADT&(IVINADT<DT)) D Q
  1. . . ; Setting USED IN THE IV FLUID ORDER ENTRY field to 'NO'
  1. . . S $P(^PS(52.7,IVSOL,0),"^",13)=0
  1. . . S ^TMP("PSS189PI",$J,OI,IVDRUG,IVSOL)=IVVOL
  1. Q
  1. ;
  1. 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
  1. ; IVSOL - IV SOLUTIONS (#52.7) Pointer
  1. ; IVVOL - IV Solution Volume
  1. ; SKPIN - Skip Inactive? (1/0)
  1. ;Output: DUPSOL - Duplicate IV SOLUTION (#52.7) Pointer (if any)
  1. ;
  1. N DUPSOL,OTHSOL,OTHVOL,OTHDRUG
  1. S (DUPSOL,OTHSOL)=0
  1. F S OTHSOL=$O(^PS(52.7,"AOI",OI,OTHSOL)) Q:'OTHSOL!DUPSOL D
  1. . ; Cannot check against itself
  1. . I (IVSOL=OTHSOL) Q
  1. . ; Not Used in the IV Order Dialog
  1. . I '$$GET1^DIQ(52.7,OTHSOL,17,"I") Q
  1. . ; Other IV Solution is INACTIVE
  1. . I SKPIN,$$GET1^DIQ(52.7,OTHSOL,8,"I"),$$GET1^DIQ(52.7,OTHSOL,8,"I")'>DT Q
  1. . ; Other IV Dispense Drug
  1. . S OTHDRUG=$$GET1^DIQ(52.7,OTHSOL,1,"I")
  1. . ; Other Dispense Drug is INACTIVE
  1. . I SKPIN,$$GET1^DIQ(50,OTHDRUG,100,"I"),$$GET1^DIQ(50,OTHDRUG,100,"I")'>DT Q
  1. . ; IV Solution Volume
  1. . S OTHVOL=$$GET1^DIQ(52.7,OTHSOL,2)
  1. . ; IV Solutions have different volumes
  1. . I (IVVOL'=OTHVOL) Q
  1. . ; Capturing the IV Solutions with issues
  1. . S DUPSOL=OTHSOL
  1. Q DUPSOL
  1. ;
  1. MSG(MSGBODY) ; Creating the Mailman Message body
  1. N LN,OI,IVDRUG,IVSOL,DUPVOL
  1. D ADDLINE(.MSGBODY,"The list below shows IV Solutions in your database that had the field")
  1. D ADDLINE(.MSGBODY,"USED IN IV FLUID ORDER ENTRY set to 'NO' because either the Orderable")
  1. D ADDLINE(.MSGBODY,"Item, the Dispense Drug or the IV Solution itself was marked INACTIVE.")
  1. D ADDLINE(.MSGBODY,"")
  1. ;
  1. D ADDLINE(.MSGBODY,"Run Date/Time: "_$$FMTE^XLFDT($$NOW^XLFDT))
  1. S $P(LN,"-",80)="" D ADDLINE(.MSGBODY,LN)
  1. D ADDLINE(.MSGBODY,"ORDERABLE ITEM (IEN)")
  1. S LN=" IV DISPENSE DRUG (IEN)" D ADDLINE(.MSGBODY,LN)
  1. S LN=" IV SOLUTION (IEN/VOLUME)" D ADDLINE(.MSGBODY,LN)
  1. S LN="",$P(LN,"-",80)="" D ADDLINE(.MSGBODY,LN)
  1. ;
  1. S (OI,IVDRUG,IVSOL)=""
  1. F S OI=$O(^TMP("PSS189PI",$J,OI)) Q:'OI D
  1. . 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:""))
  1. . F S IVDRUG=$O(^TMP("PSS189PI",$J,OI,IVDRUG)) Q:'IVDRUG D
  1. . . S LN=" "_$$GET1^DIQ(50,+IVDRUG,.01)_" ("_+IVDRUG_")"_$S($$GET1^DIQ(50,IVDRUG,100,"I"):" *** INACTIVE DATE: "_$$GET1^DIQ(50,IVDRUG,100)_" ***",1:"")
  1. . . D ADDLINE(.MSGBODY,LN)
  1. . . F S IVSOL=$O(^TMP("PSS189PI",$J,OI,IVDRUG,IVSOL)) Q:'IVSOL D
  1. . . . S DUPVOL=^TMP("PSS189PI",$J,OI,IVDRUG,IVSOL)
  1. . . . 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:"")
  1. . . . D ADDLINE(.MSGBODY,LN)
  1. . D ADDLINE(.MSGBODY,"")
  1. Q
  1. ;
  1. MAIL(MSGTEXT) ; Compose/Send the Mailman message
  1. N XMDUZ,XMSUB,XMY,XMTEXT,RECPT,SECKEY,DIFROM
  1. S XMDUZ="Patch PSS*1*189",XMSUB="Auto-update of the IV Solution file"
  1. ;
  1. ; Sending the message to the holders of the PSIVMGR, PSJI MGR and PSNMGR security key + Patch installer
  1. F SECKEY="PSIVMGR","PSJI MGR","PSNMGR" D
  1. . S RECPT=0 F S RECPT=$O(^XUSEC(SECKEY,RECPT)) Q:'RECPT S XMY(RECPT)=""
  1. S XMY(DUZ)=""
  1. S XMTEXT="MSGTEXT(" D ^XMD
  1. Q
  1. ;
  1. ADDLINE(MSG,TXT) ; Adds a line to the Mailman Message Text
  1. N LINE
  1. S LINE=$O(MSG(99999),-1)+1,MSG(LINE)=TXT
  1. Q