ORY462 ;DRM/MWA/VMP - PRE/POST INSTALL FOR PATCH OR*3.0*462 ; 8/31/17 10:39am
;;3.0;ORDER ENTRY/RESULTS REPORTING;**462**;;Build 6
;
; External References:
; ^XMD ICR #10070
;
Q
EN ;entry point
N ORX,DLG0,MSGCNT,ORMSG,DIETDG,FAILREGS
S DIETDG=$O(^ORD(100.98,"B","DIET ORDERS",0))
S ORX=0,MSGCNT=4
F S ORX=$O(^ORD(101.41,ORX)) Q:'ORX I $G(^ORD(101.41,ORX,0))'="" S DLG0=^ORD(101.41,ORX,0) D
.Q:$P(DLG0,U,4)'="Q"
.N DLG S DLG=0 F S DLG=$O(^ORD(101.41,ORX,6,"D",DLG)) Q:'DLG D
..I DLG=4,$P(DLG0,U,5)=DIETDG D REGCHK
D ADDREGS,MAIL
Q
REGCHK ; check for regular/npo diet with another diet on a diet quick order
N RPIEN S RPIEN=0,RPIEN=$O(^ORD(101.41,ORX,6,"D",DLG,RPIEN)) I RPIEN,$O(^ORD(101.41,ORX,6,"D",DLG,RPIEN)) D
.S RPIEN="" F S RPIEN=$O(^ORD(101.41,ORX,6,"D",DLG,RPIEN)) Q:'RPIEN D
..N DIET S DIET=+$G(^ORD(101.41,ORX,6,RPIEN,1))
..I ($P($G(^ORD(101.43,DIET,0)),U)="REGULAR")!($P($G(^ORD(101.43,+DIET,0)),U)="NPO") S FAILREGS(ORX)=""
Q
ADDREGS ; add any orders found in REGCHK to mail man message
I '$D(ORMSG(4)) S MSGCNT=5
S ORMSG(MSGCNT)="",MSGCNT=MSGCNT+1
S ORMSG(MSGCNT)="The following Diet Quick orders have both a Regular/NPO and another diet",MSGCNT=MSGCNT+1
S ORMSG(MSGCNT)="They must be manually edited",MSGCNT=MSGCNT+1
S ORMSG(MSGCNT)="",MSGCNT=MSGCNT+1
S FAILREGS="" I '$O(FAILREGS(FAILREGS)) S ORMSG(MSGCNT)="None Found"
S FAILREGS="" F S FAILREGS=$O(FAILREGS(FAILREGS)) Q:'FAILREGS D
.S ORMSG(MSGCNT)=$P($G(^ORD(101.41,FAILREGS,0)),U)_" IEN - "_FAILREGS,MSGCNT=MSGCNT+1
I
Q
MAIL ; send mailman message
N XMSUB,XMDUZ,XMTEXT,XMY,DIFROM
S ORMSG(1)="OR*3.0*462 install routine has completed"
S ORMSG(2)="The instances for the following quick orders have been changed"
S ORMSG(3)=" "
I '$D(ORMSG(4)) S ORMSG(4)="No changes"
S XMSUB="OR*3.0*462 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[HORY462 1982 printed Dec 13, 2024@02:42:26 Page 2
ORY462 ;DRM/MWA/VMP - PRE/POST INSTALL FOR PATCH OR*3.0*462 ; 8/31/17 10:39am
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**462**;;Build 6
+2 ;
+3 ; External References:
+4 ; ^XMD ICR #10070
+5 ;
+6 QUIT
EN ;entry point
+1 NEW ORX,DLG0,MSGCNT,ORMSG,DIETDG,FAILREGS
+2 SET DIETDG=$ORDER(^ORD(100.98,"B","DIET ORDERS",0))
+3 SET ORX=0
SET MSGCNT=4
+4 FOR
SET ORX=$ORDER(^ORD(101.41,ORX))
if 'ORX
QUIT
IF $GET(^ORD(101.41,ORX,0))'=""
SET DLG0=^ORD(101.41,ORX,0)
Begin DoDot:1
+5 if $PIECE(DLG0,U,4)'="Q"
QUIT
+6 NEW DLG
SET DLG=0
FOR
SET DLG=$ORDER(^ORD(101.41,ORX,6,"D",DLG))
if 'DLG
QUIT
Begin DoDot:2
+7 IF DLG=4
IF $PIECE(DLG0,U,5)=DIETDG
DO REGCHK
End DoDot:2
End DoDot:1
+8 DO ADDREGS
DO MAIL
+9 QUIT
REGCHK ; check for regular/npo diet with another diet on a diet quick order
+1 NEW RPIEN
SET RPIEN=0
SET RPIEN=$ORDER(^ORD(101.41,ORX,6,"D",DLG,RPIEN))
IF RPIEN
IF $ORDER(^ORD(101.41,ORX,6,"D",DLG,RPIEN))
Begin DoDot:1
+2 SET RPIEN=""
FOR
SET RPIEN=$ORDER(^ORD(101.41,ORX,6,"D",DLG,RPIEN))
if 'RPIEN
QUIT
Begin DoDot:2
+3 NEW DIET
SET DIET=+$GET(^ORD(101.41,ORX,6,RPIEN,1))
+4 IF ($PIECE($GET(^ORD(101.43,DIET,0)),U)="REGULAR")!($PIECE($GET(^ORD(101.43,+DIET,0)),U)="NPO")
SET FAILREGS(ORX)=""
End DoDot:2
End DoDot:1
+5 QUIT
ADDREGS ; add any orders found in REGCHK to mail man message
+1 IF '$DATA(ORMSG(4))
SET MSGCNT=5
+2 SET ORMSG(MSGCNT)=""
SET MSGCNT=MSGCNT+1
+3 SET ORMSG(MSGCNT)="The following Diet Quick orders have both a Regular/NPO and another diet"
SET MSGCNT=MSGCNT+1
+4 SET ORMSG(MSGCNT)="They must be manually edited"
SET MSGCNT=MSGCNT+1
+5 SET ORMSG(MSGCNT)=""
SET MSGCNT=MSGCNT+1
+6 SET FAILREGS=""
IF '$ORDER(FAILREGS(FAILREGS))
SET ORMSG(MSGCNT)="None Found"
+7 SET FAILREGS=""
FOR
SET FAILREGS=$ORDER(FAILREGS(FAILREGS))
if 'FAILREGS
QUIT
Begin DoDot:1
+8 SET ORMSG(MSGCNT)=$PIECE($GET(^ORD(101.41,FAILREGS,0)),U)_" IEN - "_FAILREGS
SET MSGCNT=MSGCNT+1
End DoDot:1
+9 IF $TEST
+10 QUIT
MAIL ; send mailman message
+1 NEW XMSUB,XMDUZ,XMTEXT,XMY,DIFROM
+2 SET ORMSG(1)="OR*3.0*462 install routine has completed"
+3 SET ORMSG(2)="The instances for the following quick orders have been changed"
+4 SET ORMSG(3)=" "
+5 IF '$DATA(ORMSG(4))
SET ORMSG(4)="No changes"
+6 SET XMSUB="OR*3.0*462 install routine has completed"
+7 SET XMDUZ="ORDER ENTRY/RESULTS REPORTING PACKAGE"
+8 SET XMTEXT="ORMSG("
+9 SET XMY(DUZ)=""
+10 DO ^XMD
+11 QUIT
