ORY386 ;MWA/VMP - PRE/POST INSTALL FOR PATCH OR*3.0*386 ; 3/12/14 12:27pm
;;3.0;ORDER ENTRY/RESULTS REPORTING;**386**;;Build 4
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
..N RPIEN S RPIEN=0,RPIEN=$O(^ORD(101.41,ORX,6,"D",DLG,RPIEN)) I RPIEN,$$OUTAORD D FIXORD
D ADDREGS,MAIL
Q
OUTAORD() ; are the instances out of order?
N INCHK,FAIL S INCHK=0,RPIEN=0,FAIL=0
F S RPIEN=$O(^ORD(101.41,ORX,6,"D",DLG,RPIEN)) Q:'RPIEN D
.I $D(^ORD(101.41,ORX,6,RPIEN,0)),$P($G(^ORD(101.41,ORX,6,RPIEN,0)),U,3) S INCHK($P($G(^ORD(101.41,ORX,6,RPIEN,0)),U,3))="",INCHK=INCHK+1
N I F I=1:1:INCHK I '$D(INCHK(I)) S FAIL=1
I FAIL Q 1
Q 0
FIXORD ; fix instance order for specific response dialog
N ICNT S ICNT=1,RPIEN=0 F S RPIEN=$O(^ORD(101.41,ORX,6,"D",DLG,RPIEN)) Q:'RPIEN D
.N DIE,DA,DR S DIE="^ORD(101.41,"_ORX_",6,",DA(1)=ORX,DA=RPIEN,DR=".03///"_ICNT D ^DIE S ICNT=ICNT+1
.I '$D(MSGCNT(ORX)) S ORMSG(MSGCNT)=$P($G(^ORD(101.41,ORX,0)),U)_" IEN - "_ORX,MSGCNT(ORX)="",MSGCNT=MSGCNT+1
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*386 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*386 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[HORY386 2732 printed Apr 09, 2024@21:41:27 Page 2
ORY386 ;MWA/VMP - PRE/POST INSTALL FOR PATCH OR*3.0*386 ; 3/12/14 12:27pm
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**386**;;Build 4
+2 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
+8 NEW RPIEN
SET RPIEN=0
SET RPIEN=$ORDER(^ORD(101.41,ORX,6,"D",DLG,RPIEN))
IF RPIEN
IF $$OUTAORD
DO FIXORD
End DoDot:2
End DoDot:1
+9 DO ADDREGS
DO MAIL
+10 QUIT
OUTAORD() ; are the instances out of order?
+1 NEW INCHK,FAIL
SET INCHK=0
SET RPIEN=0
SET FAIL=0
+2 FOR
SET RPIEN=$ORDER(^ORD(101.41,ORX,6,"D",DLG,RPIEN))
if 'RPIEN
QUIT
Begin DoDot:1
+3 IF $DATA(^ORD(101.41,ORX,6,RPIEN,0))
IF $PIECE($GET(^ORD(101.41,ORX,6,RPIEN,0)),U,3)
SET INCHK($PIECE($GET(^ORD(101.41,ORX,6,RPIEN,0)),U,3))=""
SET INCHK=INCHK+1
End DoDot:1
+4 NEW I
FOR I=1:1:INCHK
IF '$DATA(INCHK(I))
SET FAIL=1
+5 IF FAIL
QUIT 1
+6 QUIT 0
FIXORD ; fix instance order for specific response dialog
+1 NEW ICNT
SET ICNT=1
SET RPIEN=0
FOR
SET RPIEN=$ORDER(^ORD(101.41,ORX,6,"D",DLG,RPIEN))
if 'RPIEN
QUIT
Begin DoDot:1
+2 NEW DIE,DA,DR
SET DIE="^ORD(101.41,"_ORX_",6,"
SET DA(1)=ORX
SET DA=RPIEN
SET DR=".03///"_ICNT
DO ^DIE
SET ICNT=ICNT+1
+3 IF '$DATA(MSGCNT(ORX))
SET ORMSG(MSGCNT)=$PIECE($GET(^ORD(101.41,ORX,0)),U)_" IEN - "_ORX
SET MSGCNT(ORX)=""
SET MSGCNT=MSGCNT+1
End DoDot:1
+4 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*386 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*386 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
