ORXTABS4 ; SLC/PKS - Edit calls, tab parameters preferences. [9/28/00 3:05pm]
;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,47,84**;Dec 17, 1997
;
; NOTES: The routines herein are called by those of the same tag
; name in ORXTABS2. Most variables are NEW'd and assigned
; by one or more routines in the preceding call chains.
; Refer to comments and notes there for additional infor-
; mation.
;
; Each tag in this routine must return one of the following:
;
; 1 - A new value entered or selected by the user,
; 2 - A null string,
; 3 - The string "*Invalid*" - to repeat due to invalid entry,
; 4 - The "^" character, indicating user's cancel action.
;
Q
;
STATUS(TYPE) ; Status, for various tabs.
;
; Internal variables used:
;
; ORXAUTH = Holds current value of AUTHOR value for some TYPEs.
; ORXFLAG = Used in set/reset of ORDSTS^ORCHANG2 values.
; ORXP1 = Prompt piece holder.
; ORXP2 = Prompt piece holder.
; ORXSCNT = Loop counter.
; ORXSETC = Set of codes for assignment to DIR(0) variable.
; ORXSTAGS = Orders STATUS tags, in routine ORXCHANG2 or herein.
; TYPE = Type of STATUS being processed; must be one of:
;
; - ORDERS
; - CONSULTS
; - NOTES
; - D/C SUMMARIES
; - PROBLEMS
;
N ORXAUTH,ORXFLAG,ORXP1,ORXP2,ORXSCNT,ORXSETC,ORXSTAGS
;
; Process DIR call through IF statements below, based on TYPE.
;
; Orders and Consults:
;
; NOTE: Displayed choices are numerically sequential as coded.
; Actual storage number values come from routine data tags.
; Thus, the default entry must be converted before
; display, reset before updates - as is done below.
;
I ((TYPE="ORDERS")!(TYPE="CONSULTS")) D
.K ORXSTAGS ; Clean up each time.
.S ORXSCNT=0 ; Initialize counter.
.S ORXFLAG=1 ; Start true each time.
.;
.; Establish loop for tag entries:
.F D Q:(ORXSTAGS(ORXSCNT)="")!(ORXSTAGS(ORXSCNT)["ZZZ")
..S ORXSCNT=ORXSCNT+1 ; Increment counter.
..;
..; Assign retrieved values to ORXSTAGS array:
..S ORXSTAGS="ORDSTS+"_ORXSCNT_"^ORCHANG2" ; ORDERS data tag.
..;
..; For CONSULTS set a different data tag:
..I TYPE="CONSULTS" S ORXSTAGS="CORDSTS+"_ORXSCNT
..;
..S ORXSTAGS(ORXSCNT)=ORXSCNT_";"_$P($T(@ORXSTAGS),";;",2)
..I (ORXSTAGS(ORXSCNT)="")!(ORXSTAGS(ORXSCNT)["ZZZ") Q
..;
..; Reset ORXNOW (current value) number when found:
..I ORXFLAG D
...I $P(ORXSTAGS(ORXSCNT),";",2)=ORXNOW S ORXNOW=$P(ORXSTAGS(ORXSCNT),";",1) S ORXFLAG=0 ; Do only once each time.
..;
..; Continue building prompt strings from retrieved values:
..S ORXP1=$P(ORXSTAGS(ORXSCNT),";",1) ; First prompt piece.
..S ORXP1=$$LJ^XLFSTR(ORXP1,9) ; Format for 9 chars.
..S ORXP2=$P(ORXSTAGS(ORXSCNT),";",3) ; Second prompt piece.
..S ORXP2=$$LJ^XLFSTR(ORXP2,24) ; Format for 24 chars.
..;
..; Assign DIR("A") display array:
..S DIR("A",ORXSCNT)=ORXP1_ORXP2 ; Complete prompt string.
.;
.; Check for bad/missing tag data:
.I ORXSCNT<2 W !!,"ERROR: Bad data tag entry(ies)." S ORXNOW="^" Q
.;
.; Assign remaining DIR variables:
.S DIR("T")=120 ; Two minute maximum timeout for response.
.S DIR("A")=" Enter # for type of "_ORXPDIS_" to display: "
.S DIR("?")=" Entry must be between 1 and "_(ORXSCNT-1)
.S DIR(0)="NA^1:"_(ORXSCNT-1) ; Numerical, required.
.;
.; Call tag to get/assign input:
.D INPUT^ORXTABS2
.;
.; Check for user abort:
.I ORXNOW="^" Q
.;
.; Reset user entry to actual number from data tag in use:
.S:ORXNOW'="" ORXNOW=$P(ORXSTAGS(ORXNOW),";",2)
;
; Notes and D/C Summaries:
I ((TYPE="NOTES")!(TYPE="D/C SUMMARIES")) D
.;
.; Assign values retrieved to ORXSTAGS array:
.S ORXP1="1" ; First piece.
.S ORXP1=$$LJ^XLFSTR(ORXP1,9) ; Format for 9 chars.
.S ORXP2="All Signed" ; Second piece.
.S ORXP2=$$LJ^XLFSTR(ORXP2,24) ; Format for 24 chars.
.S DIR("A",1)=ORXP1_ORXP2 ; First prompt string.
.S ORXP1="2" ; First piece.
.S ORXP1=$$LJ^XLFSTR(ORXP1,9) ; Format for 9 chars.
.S ORXP2="My Unsigned" ; Second piece.
.S ORXP2=$$LJ^XLFSTR(ORXP2,24) ; Format for 24 chars.
.S DIR("A",2)=ORXP1_ORXP2 ; Second prompt string.
.S ORXP1="3" ; First piece.
.S ORXP1=$$LJ^XLFSTR(ORXP1,9) ; Format for 9 chars.
.S ORXP2="My Un-cosigned" ; Second piece.
.S ORXP2=$$LJ^XLFSTR(ORXP2,24) ; Format for 24 chars.
.S DIR("A",3)=ORXP1_ORXP2 ; Third prompt string.
.S ORXP1="4" ; First piece.
.S ORXP1=$$LJ^XLFSTR(ORXP1,9) ; Format for 9 chars.
.S ORXP2="Signed/Author" ; Second piece.
.S ORXP2=$$LJ^XLFSTR(ORXP2,24) ; Format for 24 chars.
.S DIR("A",4)=ORXP1_ORXP2 ; Fourth prompt string.
.S ORXP1="5" ; First piece.
.S ORXP1=$$LJ^XLFSTR(ORXP1,9) ; Format for 9 chars.
.S ORXP2="Signed/Dates" ; Second piece.
.S ORXP2=$$LJ^XLFSTR(ORXP2,24) ; Format for 24 chars.
.S DIR("A",5)=ORXP1_ORXP2 ; Fifth prompt string.
.;
.; Assign remaining DIR variables:
.S DIR("T")=120 ; Two minute maximum timeout for response.
.S DIR("A")=" Enter # for type of "_ORXPDIS_" to display: "
.S DIR("?")=" Entry must be between 1 and 5"
.S DIR(0)="NA^1:5" ; Numerical, required.
.;
.; Call tag to get/assign input:
.D INPUT^ORXTABS2
.;
.; Check for user abort:
.I ORXNOW="^" Q
.;
.; Use ORXAUTH twice to Check for valid entry:
.I ORXNOW'="" D
..I (ORXCNT+1)<1 W !!,"ERROR: Improper TABS entry." S ORXNOW="^" Q
..S ORXAUTH=$P($G(ORXSETS),";",ORXCNT+1)
..I ORXAUTH'="AUTHOR" W !!,"ERROR: Improper TABS entry." S ORXNOW="^" Q
..S ORXAUTH=$P($G(ORXCUR),";",$P($G(ORXPCS),";",ORXCNT+1))
..I ((ORXAUTH="")&(ORXNOW=4)) S $P(ORXCUR,";",$P($G(ORXPCS),";",ORXCNT+1))=+DUZ Q ; STATUS 4 = DUZ AUTHOR.
..I ORXAUTH="" Q ; Stop if already null.
..;
..; For all other entries, set matching AUTHOR value to null:
..S $P(ORXCUR,";",$P($G(ORXPCS),";",ORXCNT+1))=""
.;
.; Check for deletion entry:
.I ORXNOW="@" S ORXNOW=""
;
; Problems:
I TYPE="PROBLEMS" D
.K ORXSTAGS ; Clean up each time.
.S ORXSETC="" ; Clear each time.
.S ORXSCNT=0 ; Initialize counter.
.;
.; Establish loop for tag entries:
.F D Q:(ORXSTAGS(ORXSCNT)="")!(ORXSTAGS(ORXSCNT)["ZZZ")
..S ORXSCNT=ORXSCNT+1 ; Increment counter.
..;
..; Assign retrieved values to ORXSTAGS array:
..S ORXSTAGS="PLSTS+"_ORXSCNT_"^ORCHANG2" ; Data tags.
..S ORXSTAGS(ORXSCNT)=$P($T(@ORXSTAGS),";;",2)
..I (ORXSTAGS(ORXSCNT)="")!(ORXSTAGS(ORXSCNT)["ZZZ") Q
..S ORXP1=$P(ORXSTAGS(ORXSCNT),";",1) ; First prompt piece.
..S:ORXSCNT=1 ORXSETC=ORXP1_":" ; DIR codes string.
..S:ORXSCNT>1 ORXSETC=ORXSETC_";"_ORXP1_":" ; "
..S ORXP1=$$LJ^XLFSTR(ORXP1,9) ; Format for 9 chars.
..S ORXP2=$P(ORXSTAGS(ORXSCNT),";",2) ; Second prompt piece.
..S ORXSETC=ORXSETC_ORXP2 ; DIR codes string.
..S ORXP2=$$LJ^XLFSTR(ORXP2,24) ; Format for 24 chars.
..;
..; Assign DIR("A") display array:
..S DIR("A",ORXSCNT)=ORXP1_ORXP2 ; Complete prompt string.
.;
.; Check for bad/missing data:
.I ORXSCNT<2 W !!,"ERROR: Bad PLSTS tag data." S ORXNOW="^" Q
.;
.; Assign remaining DIR variables:
.S DIR("T")=120 ; Two minute maximum timeout for response.
.S DIR("A")=" Enter types of "_ORXPDIS_" to display: "
.S DIR(0)="SAO^"_ORXSETC ; Optional, Set of Codes.
.;
.; Call tag to get/assign input:
.D INPUT^ORXTABS2
.;
.; Check for user abort:
.I ORXNOW="^" Q
.;
.; Check for deletion entry:
.I ORXNOW="@" S ORXNOW=""
;
Q
;
;
; NOTES ON ENTRIES FOR "CORDSTS" TAG:
; CORDSTS entries below match previous LM CONSULTS ORDERS
; "STATUS" settings allowed. They are also listed in the
; ORQ1 routine. The listings consist of 2 pieces:
;
; ValueToBeStoredInParam;ListingDescription
;
CORDSTS ; Consults ORDERS "STATUS" settings.
;;1;Discontinued
;;2;Complete
;;5;Pending
;;6;Active
;;8;Scheduled
;;9;Partial Results
;;13;Cancelled
;;;All Statuses
;;;ZZZZ
;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORXTABS4 9047 printed Nov 22, 2024@17:48:08 Page 2
ORXTABS4 ; SLC/PKS - Edit calls, tab parameters preferences. [9/28/00 3:05pm]
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,47,84**;Dec 17, 1997
+2 ;
+3 ; NOTES: The routines herein are called by those of the same tag
+4 ; name in ORXTABS2. Most variables are NEW'd and assigned
+5 ; by one or more routines in the preceding call chains.
+6 ; Refer to comments and notes there for additional infor-
+7 ; mation.
+8 ;
+9 ; Each tag in this routine must return one of the following:
+10 ;
+11 ; 1 - A new value entered or selected by the user,
+12 ; 2 - A null string,
+13 ; 3 - The string "*Invalid*" - to repeat due to invalid entry,
+14 ; 4 - The "^" character, indicating user's cancel action.
+15 ;
+16 QUIT
+17 ;
STATUS(TYPE) ; Status, for various tabs.
+1 ;
+2 ; Internal variables used:
+3 ;
+4 ; ORXAUTH = Holds current value of AUTHOR value for some TYPEs.
+5 ; ORXFLAG = Used in set/reset of ORDSTS^ORCHANG2 values.
+6 ; ORXP1 = Prompt piece holder.
+7 ; ORXP2 = Prompt piece holder.
+8 ; ORXSCNT = Loop counter.
+9 ; ORXSETC = Set of codes for assignment to DIR(0) variable.
+10 ; ORXSTAGS = Orders STATUS tags, in routine ORXCHANG2 or herein.
+11 ; TYPE = Type of STATUS being processed; must be one of:
+12 ;
+13 ; - ORDERS
+14 ; - CONSULTS
+15 ; - NOTES
+16 ; - D/C SUMMARIES
+17 ; - PROBLEMS
+18 ;
+19 NEW ORXAUTH,ORXFLAG,ORXP1,ORXP2,ORXSCNT,ORXSETC,ORXSTAGS
+20 ;
+21 ; Process DIR call through IF statements below, based on TYPE.
+22 ;
+23 ; Orders and Consults:
+24 ;
+25 ; NOTE: Displayed choices are numerically sequential as coded.
+26 ; Actual storage number values come from routine data tags.
+27 ; Thus, the default entry must be converted before
+28 ; display, reset before updates - as is done below.
+29 ;
+30 IF ((TYPE="ORDERS")!(TYPE="CONSULTS"))
Begin DoDot:1
+31 ; Clean up each time.
KILL ORXSTAGS
+32 ; Initialize counter.
SET ORXSCNT=0
+33 ; Start true each time.
SET ORXFLAG=1
+34 ;
+35 ; Establish loop for tag entries:
+36 FOR
Begin DoDot:2
+37 ; Increment counter.
SET ORXSCNT=ORXSCNT+1
+38 ;
+39 ; Assign retrieved values to ORXSTAGS array:
+40 ; ORDERS data tag.
SET ORXSTAGS="ORDSTS+"_ORXSCNT_"^ORCHANG2"
+41 ;
+42 ; For CONSULTS set a different data tag:
+43 IF TYPE="CONSULTS"
SET ORXSTAGS="CORDSTS+"_ORXSCNT
+44 ;
+45 SET ORXSTAGS(ORXSCNT)=ORXSCNT_";"_$PIECE($TEXT(@ORXSTAGS),";;",2)
+46 IF (ORXSTAGS(ORXSCNT)="")!(ORXSTAGS(ORXSCNT)["ZZZ")
QUIT
+47 ;
+48 ; Reset ORXNOW (current value) number when found:
+49 IF ORXFLAG
Begin DoDot:3
+50 ; Do only once each time.
IF $PIECE(ORXSTAGS(ORXSCNT),";",2)=ORXNOW
SET ORXNOW=$PIECE(ORXSTAGS(ORXSCNT),";",1)
SET ORXFLAG=0
End DoDot:3
+51 ;
+52 ; Continue building prompt strings from retrieved values:
+53 ; First prompt piece.
SET ORXP1=$PIECE(ORXSTAGS(ORXSCNT),";",1)
+54 ; Format for 9 chars.
SET ORXP1=$$LJ^XLFSTR(ORXP1,9)
+55 ; Second prompt piece.
SET ORXP2=$PIECE(ORXSTAGS(ORXSCNT),";",3)
+56 ; Format for 24 chars.
SET ORXP2=$$LJ^XLFSTR(ORXP2,24)
+57 ;
+58 ; Assign DIR("A") display array:
+59 ; Complete prompt string.
SET DIR("A",ORXSCNT)=ORXP1_ORXP2
End DoDot:2
if (ORXSTAGS(ORXSCNT)="")!(ORXSTAGS(ORXSCNT)["ZZZ")
QUIT
+60 ;
+61 ; Check for bad/missing tag data:
+62 IF ORXSCNT<2
WRITE !!,"ERROR: Bad data tag entry(ies)."
SET ORXNOW="^"
QUIT
+63 ;
+64 ; Assign remaining DIR variables:
+65 ; Two minute maximum timeout for response.
SET DIR("T")=120
+66 SET DIR("A")=" Enter # for type of "_ORXPDIS_" to display: "
+67 SET DIR("?")=" Entry must be between 1 and "_(ORXSCNT-1)
+68 ; Numerical, required.
SET DIR(0)="NA^1:"_(ORXSCNT-1)
+69 ;
+70 ; Call tag to get/assign input:
+71 DO INPUT^ORXTABS2
+72 ;
+73 ; Check for user abort:
+74 IF ORXNOW="^"
QUIT
+75 ;
+76 ; Reset user entry to actual number from data tag in use:
+77 if ORXNOW'=""
SET ORXNOW=$PIECE(ORXSTAGS(ORXNOW),";",2)
End DoDot:1
+78 ;
+79 ; Notes and D/C Summaries:
+80 IF ((TYPE="NOTES")!(TYPE="D/C SUMMARIES"))
Begin DoDot:1
+81 ;
+82 ; Assign values retrieved to ORXSTAGS array:
+83 ; First piece.
SET ORXP1="1"
+84 ; Format for 9 chars.
SET ORXP1=$$LJ^XLFSTR(ORXP1,9)
+85 ; Second piece.
SET ORXP2="All Signed"
+86 ; Format for 24 chars.
SET ORXP2=$$LJ^XLFSTR(ORXP2,24)
+87 ; First prompt string.
SET DIR("A",1)=ORXP1_ORXP2
+88 ; First piece.
SET ORXP1="2"
+89 ; Format for 9 chars.
SET ORXP1=$$LJ^XLFSTR(ORXP1,9)
+90 ; Second piece.
SET ORXP2="My Unsigned"
+91 ; Format for 24 chars.
SET ORXP2=$$LJ^XLFSTR(ORXP2,24)
+92 ; Second prompt string.
SET DIR("A",2)=ORXP1_ORXP2
+93 ; First piece.
SET ORXP1="3"
+94 ; Format for 9 chars.
SET ORXP1=$$LJ^XLFSTR(ORXP1,9)
+95 ; Second piece.
SET ORXP2="My Un-cosigned"
+96 ; Format for 24 chars.
SET ORXP2=$$LJ^XLFSTR(ORXP2,24)
+97 ; Third prompt string.
SET DIR("A",3)=ORXP1_ORXP2
+98 ; First piece.
SET ORXP1="4"
+99 ; Format for 9 chars.
SET ORXP1=$$LJ^XLFSTR(ORXP1,9)
+100 ; Second piece.
SET ORXP2="Signed/Author"
+101 ; Format for 24 chars.
SET ORXP2=$$LJ^XLFSTR(ORXP2,24)
+102 ; Fourth prompt string.
SET DIR("A",4)=ORXP1_ORXP2
+103 ; First piece.
SET ORXP1="5"
+104 ; Format for 9 chars.
SET ORXP1=$$LJ^XLFSTR(ORXP1,9)
+105 ; Second piece.
SET ORXP2="Signed/Dates"
+106 ; Format for 24 chars.
SET ORXP2=$$LJ^XLFSTR(ORXP2,24)
+107 ; Fifth prompt string.
SET DIR("A",5)=ORXP1_ORXP2
+108 ;
+109 ; Assign remaining DIR variables:
+110 ; Two minute maximum timeout for response.
SET DIR("T")=120
+111 SET DIR("A")=" Enter # for type of "_ORXPDIS_" to display: "
+112 SET DIR("?")=" Entry must be between 1 and 5"
+113 ; Numerical, required.
SET DIR(0)="NA^1:5"
+114 ;
+115 ; Call tag to get/assign input:
+116 DO INPUT^ORXTABS2
+117 ;
+118 ; Check for user abort:
+119 IF ORXNOW="^"
QUIT
+120 ;
+121 ; Use ORXAUTH twice to Check for valid entry:
+122 IF ORXNOW'=""
Begin DoDot:2
+123 IF (ORXCNT+1)<1
WRITE !!,"ERROR: Improper TABS entry."
SET ORXNOW="^"
QUIT
+124 SET ORXAUTH=$PIECE($GET(ORXSETS),";",ORXCNT+1)
+125 IF ORXAUTH'="AUTHOR"
WRITE !!,"ERROR: Improper TABS entry."
SET ORXNOW="^"
QUIT
+126 SET ORXAUTH=$PIECE($GET(ORXCUR),";",$PIECE($GET(ORXPCS),";",ORXCNT+1))
+127 ; STATUS 4 = DUZ AUTHOR.
IF ((ORXAUTH="")&(ORXNOW=4))
SET $PIECE(ORXCUR,";",$PIECE($GET(ORXPCS),";",ORXCNT+1))=+DUZ
QUIT
+128 ; Stop if already null.
IF ORXAUTH=""
QUIT
+129 ;
+130 ; For all other entries, set matching AUTHOR value to null:
+131 SET $PIECE(ORXCUR,";",$PIECE($GET(ORXPCS),";",ORXCNT+1))=""
End DoDot:2
+132 ;
+133 ; Check for deletion entry:
+134 IF ORXNOW="@"
SET ORXNOW=""
End DoDot:1
+135 ;
+136 ; Problems:
+137 IF TYPE="PROBLEMS"
Begin DoDot:1
+138 ; Clean up each time.
KILL ORXSTAGS
+139 ; Clear each time.
SET ORXSETC=""
+140 ; Initialize counter.
SET ORXSCNT=0
+141 ;
+142 ; Establish loop for tag entries:
+143 FOR
Begin DoDot:2
+144 ; Increment counter.
SET ORXSCNT=ORXSCNT+1
+145 ;
+146 ; Assign retrieved values to ORXSTAGS array:
+147 ; Data tags.
SET ORXSTAGS="PLSTS+"_ORXSCNT_"^ORCHANG2"
+148 SET ORXSTAGS(ORXSCNT)=$PIECE($TEXT(@ORXSTAGS),";;",2)
+149 IF (ORXSTAGS(ORXSCNT)="")!(ORXSTAGS(ORXSCNT)["ZZZ")
QUIT
+150 ; First prompt piece.
SET ORXP1=$PIECE(ORXSTAGS(ORXSCNT),";",1)
+151 ; DIR codes string.
if ORXSCNT=1
SET ORXSETC=ORXP1_":"
+152 ; "
if ORXSCNT>1
SET ORXSETC=ORXSETC_";"_ORXP1_":"
+153 ; Format for 9 chars.
SET ORXP1=$$LJ^XLFSTR(ORXP1,9)
+154 ; Second prompt piece.
SET ORXP2=$PIECE(ORXSTAGS(ORXSCNT),";",2)
+155 ; DIR codes string.
SET ORXSETC=ORXSETC_ORXP2
+156 ; Format for 24 chars.
SET ORXP2=$$LJ^XLFSTR(ORXP2,24)
+157 ;
+158 ; Assign DIR("A") display array:
+159 ; Complete prompt string.
SET DIR("A",ORXSCNT)=ORXP1_ORXP2
End DoDot:2
if (ORXSTAGS(ORXSCNT)="")!(ORXSTAGS(ORXSCNT)["ZZZ")
QUIT
+160 ;
+161 ; Check for bad/missing data:
+162 IF ORXSCNT<2
WRITE !!,"ERROR: Bad PLSTS tag data."
SET ORXNOW="^"
QUIT
+163 ;
+164 ; Assign remaining DIR variables:
+165 ; Two minute maximum timeout for response.
SET DIR("T")=120
+166 SET DIR("A")=" Enter types of "_ORXPDIS_" to display: "
+167 ; Optional, Set of Codes.
SET DIR(0)="SAO^"_ORXSETC
+168 ;
+169 ; Call tag to get/assign input:
+170 DO INPUT^ORXTABS2
+171 ;
+172 ; Check for user abort:
+173 IF ORXNOW="^"
QUIT
+174 ;
+175 ; Check for deletion entry:
+176 IF ORXNOW="@"
SET ORXNOW=""
End DoDot:1
+177 ;
+178 QUIT
+179 ;
+180 ;
+181 ; NOTES ON ENTRIES FOR "CORDSTS" TAG:
+182 ; CORDSTS entries below match previous LM CONSULTS ORDERS
+183 ; "STATUS" settings allowed. They are also listed in the
+184 ; ORQ1 routine. The listings consist of 2 pieces:
+185 ;
+186 ; ValueToBeStoredInParam;ListingDescription
+187 ;
CORDSTS ; Consults ORDERS "STATUS" settings.
+1 ;;1;Discontinued
+2 ;;2;Complete
+3 ;;5;Pending
+4 ;;6;Active
+5 ;;8;Scheduled
+6 ;;9;Partial Results
+7 ;;13;Cancelled
+8 ;;;All Statuses
+9 ;;;ZZZZ
+10 ;
+11 QUIT
+12 ;
