ORY461 ; HPS/MWA - Post install routine for OR*3*461 ; 6/9/17 11:22am
;;3.0;ORDER ENTRY/RESULTS REPORTING;**461**;;Build 8
Q ;only allow routine to be run from entry points
EN ; main entry point
N I,II,III,IIII,IDG,DIA,INPTS,IEN,MSGCNT,ORMSG
S MSGCNT=5
S IDG="",IDG=$O(^ORD(100.98,"B","INPATIENT MEDICATIONS",IDG))
S DIA="",DIA=$O(^ORD(101.41,"B","PSJ OR PAT OE",DIA))
;get all currently admitted patients
S I="" F S I=$O(^DPT("ACN",I)) Q:'$L(I) D
.S II="" F S II=$O(^DPT("ACN",I,II)) Q:'$L(II) D
..S INPTS(II_";DPT(")=""
S I="" F S I=$O(INPTS(I)) Q:'$L(I) D
.S II="" F S II=$O(^OR(100,"AW",I,II)) Q:'$L(II) D
..S III="" F S III=$O(^OR(100,"AW",I,II,III)) Q:'$L(III) D
...Q:($E(III,1,3)<316)
...S IIII="" F S IIII=$O(^OR(100,"AW",I,II,III,IIII)) Q:'$L(IIII) D
....S IEN=IIII I "^3^5^6^10^11^"[(U_$P($G(^OR(100,IEN,3)),U,3)_U),$P($G(^OR(100,IEN,0)),U,5)=(DIA_";ORD(101.41,"),$P(^OR(100,IIII,0),U,11)=IDG D FIX
D MAIL
Q
FIX ; fix
; I II III IIII
; ^OR(100,"AW",<OBJECT OF ORDER>,<DISPLAY GROUP>,<START DATE>,<ORDER#>)
N DA,DR,DIE S DIE="^OR(100,",DA=IIII,DR="23///UNIT DOSE MEDICATIONS" D ^DIE
S ORMSG(MSGCNT)=IIII,MSGCNT=MSGCNT+1
Q
MAIL ; send mailman message
N XMSUB,XMDUZ,XMTEXT,XMY,DIFROM
S ORMSG(1)="OR*3.0*461 Post install routine has completed"
S ORMSG(2)="The following order(s) have had their display group changed"
S ORMSG(3)="from INPATIENT MEDICATIONS to UNIT DOSE MEDICATIONS"
S ORMSG(4)="**INFORMATIONAL ONLY - No action required** :"
I '$D(ORMSG(5)) S ORMSG(5)="No changes"
S XMSUB="OR*3.0*461 Post install routine has completed"
S XMDUZ="ORDER ENTRY/RESULTS REPORTING PACKAGE"
S XMTEXT="ORMSG("
S XMY(DUZ)=""
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORY461 1772 printed Apr 09, 2024@21:42 Page 2
ORY461 ; HPS/MWA - Post install routine for OR*3*461 ; 6/9/17 11:22am
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**461**;;Build 8
+2 ;only allow routine to be run from entry points
QUIT
EN ; main entry point
+1 NEW I,II,III,IIII,IDG,DIA,INPTS,IEN,MSGCNT,ORMSG
+2 SET MSGCNT=5
+3 SET IDG=""
SET IDG=$ORDER(^ORD(100.98,"B","INPATIENT MEDICATIONS",IDG))
+4 SET DIA=""
SET DIA=$ORDER(^ORD(101.41,"B","PSJ OR PAT OE",DIA))
+5 ;get all currently admitted patients
+6 SET I=""
FOR
SET I=$ORDER(^DPT("ACN",I))
if '$LENGTH(I)
QUIT
Begin DoDot:1
+7 SET II=""
FOR
SET II=$ORDER(^DPT("ACN",I,II))
if '$LENGTH(II)
QUIT
Begin DoDot:2
+8 SET INPTS(II_";DPT(")=""
End DoDot:2
End DoDot:1
+9 SET I=""
FOR
SET I=$ORDER(INPTS(I))
if '$LENGTH(I)
QUIT
Begin DoDot:1
+10 SET II=""
FOR
SET II=$ORDER(^OR(100,"AW",I,II))
if '$LENGTH(II)
QUIT
Begin DoDot:2
+11 SET III=""
FOR
SET III=$ORDER(^OR(100,"AW",I,II,III))
if '$LENGTH(III)
QUIT
Begin DoDot:3
+12 if ($EXTRACT(III,1,3)<316)
QUIT
+13 SET IIII=""
FOR
SET IIII=$ORDER(^OR(100,"AW",I,II,III,IIII))
if '$LENGTH(IIII)
QUIT
Begin DoDot:4
+14 SET IEN=IIII
IF "^3^5^6^10^11^"[(U_$PIECE($GET(^OR(100,IEN,3)),U,3)_U)
IF $PIECE($GET(^OR(100,IEN,0)),U,5)=(DIA_";ORD(101.41,")
IF $PIECE(^OR(100,IIII,0),U,11)=IDG
DO FIX
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+15 DO MAIL
+16 QUIT
FIX ; fix
+1 ; I II III IIII
+2 ; ^OR(100,"AW",<OBJECT OF ORDER>,<DISPLAY GROUP>,<START DATE>,<ORDER#>)
+3 NEW DA,DR,DIE
SET DIE="^OR(100,"
SET DA=IIII
SET DR="23///UNIT DOSE MEDICATIONS"
DO ^DIE
+4 SET ORMSG(MSGCNT)=IIII
SET MSGCNT=MSGCNT+1
+5 QUIT
MAIL ; send mailman message
+1 NEW XMSUB,XMDUZ,XMTEXT,XMY,DIFROM
+2 SET ORMSG(1)="OR*3.0*461 Post install routine has completed"
+3 SET ORMSG(2)="The following order(s) have had their display group changed"
+4 SET ORMSG(3)="from INPATIENT MEDICATIONS to UNIT DOSE MEDICATIONS"
+5 SET ORMSG(4)="**INFORMATIONAL ONLY - No action required** :"
+6 IF '$DATA(ORMSG(5))
SET ORMSG(5)="No changes"
+7 SET XMSUB="OR*3.0*461 Post install routine has completed"
+8 SET XMDUZ="ORDER ENTRY/RESULTS REPORTING PACKAGE"
+9 SET XMTEXT="ORMSG("
+10 SET XMY(DUZ)=""
+11 DO ^XMD
+12 QUIT
