- 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 Mar 13, 2025@21:47:23 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
