- 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 Feb 19, 2025@00:08:10 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