SCRPW303 ; BPFO/JRC - Performance Monitor Report Utils; 30 Jul 2003 ; 4/2/04 7:21am
;;5.3;SCHEDULING;**292,313,438**; AUG 13, 1993
;
DSS(SCRNARR) ;Set Stop Codes into screen array (prompt is one/many/all)
;Input : SCRNARR - Screen array full global reference
;Output : 1 = OK 0 = User abort/timeout
; @SCRNARR@("DSS") = User pick all stop codes ?
; 1 = Yes (all) 0 = No
; @SCRNARR@("DSS-NTNL") = Only stop codes in national cohort ?
; 1 = Yes 0 = No
; @SCRNARR@("DSS",PtrStopCode) = Stop Code Name
; @SCRNARR@("DSS-EXCLUDE",PtrStopCod) = SC Name
;Note : @SCRNARR@("DSS") is initialized (KILLed) on input
; : @SCRNARR@("DSS",PtrStopCode) is only set when the user
; picked individual stop codes (i.e. didn't pick all) OR
; when user selected stop codes by range (i.e. 100,102-300)
; : @SCRNARR@("DSS-EXCLUDE") is only set if the user picked ALL
; stop codes and choose to only use stop codes & credit pairs
; from the national cohort
; : @SCRNARR@("DSS-EXCLUDE") is set when
; @SCRNARR@("DSS-NTNL") equals 1
;
;Declare variables
N VAUTSTR,VAUTVB,VAUTNI,DSS,SCANARR,DIC,DIR,Y,X,CODE,ARRY,DIRUT,FLG
K @SCRNARR@("DSS")
;Prompt user wether to use range for stop code selection or not
S DIR(0)="Y",DIR("B")="No",FLG=0
S DIR("A")="Would you like to select the Stop Codes by range "
D ^DIR
I $D(DIRUT)!$D(DTOUT) Q FLG
I Y D RANGE(SCRNARR) Q FLG
;Get stop code selection using VAUTOMA
I '$D(@SCRNARR@("DSS"))
S DIC="^DIC(40.7,"
S VAUTSTR="Stop Code"
S VAUTVB="SCANARR"
S VAUTNI=2
D FIRST^VAUTOMA
I Y<0 Q 0
;Does selection of ALL mean all stop codes in national cohort
I $G(SCANARR)=1 D
.N DIR,X,Y,DIRUT,DIROUT,DTOUT,DUOUT
.S DIR(0)="Y"
.S DIR("B")="YES"
.S DIR("A",1)="By ALL do you mean stop codes from the"
.S DIR("A")="Performance Monitor national cohort "
.D ^DIR
.I $D(DIRUT) K SCANARR Q
.I Y D NTNLESC(SCRNARR)
.Q
I '$D(SCANARR) Q 0
I $D(@SCRNARR@("DSS")) Q 1
S @SCRNARR@("DSS-NTNL")=0
M @SCRNARR@("DSS")=SCANARR
Q 1
;
SORT(SORTARR) ; Set sort order into sort array
;Input : SORTARR - Sort array full global reference
;Output : 1 = OK 0 = User abort/timeout
; @SORTARR = Sort1Code^Sort2Code
; Codes: 1 = Division 2 = Clinic
; 3 = Provider 4 = Stop Code
; 5 = Date 6 = Patient
; @SORTARR@("TEXT") = Sort1Text^Sort2Text
;Note : @SORTARR is initialized (KILLed) on input
;
;Declare variables
N DIR,X,Y,DIRUT,DIROUT,DTOUT,DUOUT
K @SORTARR
;Get sort level 1
S DIR(0)="SC^1:DIVISION;2:CLINIC;3:PROVIDER;4:STOP CODE;5:DATE;6:PATIENT"
S DIR("A")="Select primary sorting criteria"
D ^DIR
I $D(DIRUT) Q 0
S @SORTARR=Y
S @SORTARR@("TEXT")=$$SRT2TXT(Y)
;Get sort level 2
K DIR,X,Y
S DIR(0)="SC^1:DIVISION;2:CLINIC;3:PROVIDER;4:STOP CODE;5:DATE;6:PATIENT"
S DIR("A")="Within "_@SORTARR@("TEXT")_" sort by"
S DIR("S")="I Y'="_@SORTARR
D ^DIR
I $D(DIRUT) K @SORTARR Q 0
S @SORTARR=@SORTARR_"^"_Y
S @SORTARR@("TEXT")=@SORTARR@("TEXT")_"^"_$$SRT2TXT(Y)
Q 1
SRT2TXT(CODE) ;Convert sort code to sort text
;Input : CODE - Sort code
;Output : Text for sort code
;
I CODE=1 Q "division"
I CODE=2 Q "clinic"
I CODE=3 Q "provider"
I CODE=4 Q "stop code"
I CODE=5 Q "date"
I CODE=6 Q "patient"
Q ""
;
ROLLUP(SCRNARR,SORTARR) ;Set screen and sort arrays for national rollup
;Input : SCRNARR - Screening array
; SORTARR - Sort array full global reference
;Output : None
; Nodes in @SCRNARR are set to denote the following:
; Time limit of 10
; Include all divisions
; Use excluded stop codes from national cohort array
; Count encounters with scanned progress notes
; Nodes in @SORTARR are set to denote the following:
; Primary sort is division
; Secondary sort is date
;Note : @SCRNARR and @SORTARR are initialized (KILLed) on input
;
K @SCRNARR,@SORTARR
S @SCRNARR@("TLMT")=10
S @SCRNARR@("DIVISION")=1
S @SCRNARR@("PROVIDERS")=1
D NTNLESC(SCRNARR)
S @SCRNARR@("SCANNED")=1
S @SORTARR="1^5"
S @SORTARR@("TEXT")="division^date"
Q
;
NTNLSC(SCRNARR) ;Set inclusion array of stop codes for national reporting
;Input : SCRNARR - Screening array
;Output : National list of acceptable stop code & credit pairs
; @SCRNARR@("DSS") = 0
; @SCRNARR@("DSS-NTNL") = 1
; @SCRNARR@("DSS",PtrStopCode) = Stop Code Name
; @SCRNARR@("DSS-PAIR",PtrStopCode,PtrStopCode) = SC Name ^ SC Name
;
N OFF,TEXT,J,CODE,PTR1,TMP,PTR2
S @SCRNARR@("DSS")=0
S @SCRNARR@("DSS-NTNL")=1
F OFF=1:1 S TEXT=$P($T(STOP+OFF),";;",2) Q:TEXT="END" D
.F J=1:1:$L(TEXT,"^") S CODE=$P(TEXT,"^",J) D
..S TMP=$L(CODE) Q:((TMP'=3)&(TMP'=6))
..I TMP=3 D Q
...;Individual stop code
...S PTR1=$$SC2PTR(CODE) Q:'PTR1
...S @SCRNARR@("DSS",+PTR1)=$P(PTR1,"^",2)
..;Credit pair
..S PTR1=$$SC2PTR($E(CODE,1,3)) Q:'PTR1
..S PTR2=$$SC2PTR($E(CODE,4,6)) Q:'PTR2
..S @SCRNARR@("DSS-PAIR",+PTR1,+PTR2)=$P(PTR1,"^",2)_"^"_$P(PTR2,"^",2)
Q
NTNLESC(SCRNARR) ;Set exclusion array of stop codes for national reporting
;Input : SCRNARR - Screening array
;Output : National list of stop codes to be excluded
; @SCRNARR@("DSS") = 0
; @SCRNARR@("DSS-NTNL") = 1
; @SCRNARR@("DSS-EXCLUDE",PtrStopCode) = Stop Code Name
;
N OFF,TEXT,J,CODE,PTR1,TMP,PTR2
S @SCRNARR@("DSS")=0
S @SCRNARR@("DSS-NTNL")=1
F OFF=1:1 S TEXT=$P($T(EXCSTOP+OFF),";;",2) Q:TEXT="END" D
.F J=1:1:$L(TEXT,"^") S CODE=$P(TEXT,"^",J) D
..S TMP=$L(CODE) Q:((TMP'=3)&(TMP'=6))
..I TMP=3 D Q
...;Individual stop code for exclusion
...S PTR1=$$SC2PTR(CODE) Q:'PTR1
...S @SCRNARR@("DSS-EXCLUDE",+PTR1)=$P(PTR1,"^",2)
Q
RANGE(SCRNARR) ;Screen array by range
N DIR,DIRUT,DTOUT,Y,SUB,NODE,CODE,PTR1,J
S @SCRNARR@("DSS")=0
S @SCRNARR@("DSS",1)=""
S @SCRNARR@("DSS-NTNL")=0
S DIR("A")="Select individual Stop Code or a range of Codes "
S DIR("?")="This response must be a list or range, e.g., 100,302 or 200-450,800 "
S DIR(0)="L"
D ^DIR
I $D(DIRUT)!$D(DTOUT) Q
I Y D
.S FLG=1
.S SUB="" F S SUB=$O(Y(SUB)) Q:SUB="" D
..S NODE=(Y(SUB))
..F J=1:1:$L(NODE,",") S CODE=$P(NODE,",",J) I CODE D
...S PTR1=$$SC2PTR(CODE) Q:'PTR1
...S @SCRNARR@("DSS",+PTR1)=$P(PTR1,"^",2)
Q
SC2PTR(CODE) ;Get pointer to stop code
;Input : CODE - Stop code
;Output : Pointer #40.7 ^ Name (#.01)
;
N NODE,PTR
S PTR=+$O(^DIC(40.7,"C",CODE,0)) I 'PTR Q "0^INVALID STOP CODE"
S NODE=$G(^DIC(40.7,PTR,0))
Q PTR_"^"_$P(NODE,"^",1)
;
STOP ;List of acceptable stop codes and credit pairs
;;END
;
EXCSTOP ;Exclusion list of stop codes
;;104^105^106^107^108^109^115^116^117^120^126^127^128^144^145
;;146^149^150^151^152^153^154^155^165^166^167^168^169^174^190
;;202^205^206^207^208^212^213^214^290^291^292^293^294^295^296
;;321^327^328^329^333^334^370^417^421^422^423^429^430^431^435
;;450^451^452^453^454^455^456^458^459^460^461^462^463^464^465
;;466^467^468^469^470^471^472^473^474^475^476^477^478^479^481
;;482^483^484^485^505^506^510^513^516^519^521^522^523^525^535
;;538^545^547^550^553^554^557^558^559^560^561^563^564^565^566
;;573^574^575^577^578^590^602^603^604^606^607^608^610^650^651
;;652^653^654^655^656^657^660^670^680^681^682^690^691^701^702
;;703^704^705^706^707^708^709^710^711^725^730^731^900^999
;;END
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCRPW303 7615 printed Dec 13, 2024@02:43:37 Page 2
SCRPW303 ; BPFO/JRC - Performance Monitor Report Utils; 30 Jul 2003 ; 4/2/04 7:21am
+1 ;;5.3;SCHEDULING;**292,313,438**; AUG 13, 1993
+2 ;
DSS(SCRNARR) ;Set Stop Codes into screen array (prompt is one/many/all)
+1 ;Input : SCRNARR - Screen array full global reference
+2 ;Output : 1 = OK 0 = User abort/timeout
+3 ; @SCRNARR@("DSS") = User pick all stop codes ?
+4 ; 1 = Yes (all) 0 = No
+5 ; @SCRNARR@("DSS-NTNL") = Only stop codes in national cohort ?
+6 ; 1 = Yes 0 = No
+7 ; @SCRNARR@("DSS",PtrStopCode) = Stop Code Name
+8 ; @SCRNARR@("DSS-EXCLUDE",PtrStopCod) = SC Name
+9 ;Note : @SCRNARR@("DSS") is initialized (KILLed) on input
+10 ; : @SCRNARR@("DSS",PtrStopCode) is only set when the user
+11 ; picked individual stop codes (i.e. didn't pick all) OR
+12 ; when user selected stop codes by range (i.e. 100,102-300)
+13 ; : @SCRNARR@("DSS-EXCLUDE") is only set if the user picked ALL
+14 ; stop codes and choose to only use stop codes & credit pairs
+15 ; from the national cohort
+16 ; : @SCRNARR@("DSS-EXCLUDE") is set when
+17 ; @SCRNARR@("DSS-NTNL") equals 1
+18 ;
+19 ;Declare variables
+20 NEW VAUTSTR,VAUTVB,VAUTNI,DSS,SCANARR,DIC,DIR,Y,X,CODE,ARRY,DIRUT,FLG
+21 KILL @SCRNARR@("DSS")
+22 ;Prompt user wether to use range for stop code selection or not
+23 SET DIR(0)="Y"
SET DIR("B")="No"
SET FLG=0
+24 SET DIR("A")="Would you like to select the Stop Codes by range "
+25 DO ^DIR
+26 IF $DATA(DIRUT)!$DATA(DTOUT)
QUIT FLG
+27 IF Y
DO RANGE(SCRNARR)
QUIT FLG
+28 ;Get stop code selection using VAUTOMA
+29 IF '$DATA(@SCRNARR@("DSS"))
+30 SET DIC="^DIC(40.7,"
+31 SET VAUTSTR="Stop Code"
+32 SET VAUTVB="SCANARR"
+33 SET VAUTNI=2
+34 DO FIRST^VAUTOMA
+35 IF Y<0
QUIT 0
+36 ;Does selection of ALL mean all stop codes in national cohort
+37 IF $GET(SCANARR)=1
Begin DoDot:1
+38 NEW DIR,X,Y,DIRUT,DIROUT,DTOUT,DUOUT
+39 SET DIR(0)="Y"
+40 SET DIR("B")="YES"
+41 SET DIR("A",1)="By ALL do you mean stop codes from the"
+42 SET DIR("A")="Performance Monitor national cohort "
+43 DO ^DIR
+44 IF $DATA(DIRUT)
KILL SCANARR
QUIT
+45 IF Y
DO NTNLESC(SCRNARR)
+46 QUIT
End DoDot:1
+47 IF '$DATA(SCANARR)
QUIT 0
+48 IF $DATA(@SCRNARR@("DSS"))
QUIT 1
+49 SET @SCRNARR@("DSS-NTNL")=0
+50 MERGE @SCRNARR@("DSS")=SCANARR
+51 QUIT 1
+52 ;
SORT(SORTARR) ; Set sort order into sort array
+1 ;Input : SORTARR - Sort array full global reference
+2 ;Output : 1 = OK 0 = User abort/timeout
+3 ; @SORTARR = Sort1Code^Sort2Code
+4 ; Codes: 1 = Division 2 = Clinic
+5 ; 3 = Provider 4 = Stop Code
+6 ; 5 = Date 6 = Patient
+7 ; @SORTARR@("TEXT") = Sort1Text^Sort2Text
+8 ;Note : @SORTARR is initialized (KILLed) on input
+9 ;
+10 ;Declare variables
+11 NEW DIR,X,Y,DIRUT,DIROUT,DTOUT,DUOUT
+12 KILL @SORTARR
+13 ;Get sort level 1
+14 SET DIR(0)="SC^1:DIVISION;2:CLINIC;3:PROVIDER;4:STOP CODE;5:DATE;6:PATIENT"
+15 SET DIR("A")="Select primary sorting criteria"
+16 DO ^DIR
+17 IF $DATA(DIRUT)
QUIT 0
+18 SET @SORTARR=Y
+19 SET @SORTARR@("TEXT")=$$SRT2TXT(Y)
+20 ;Get sort level 2
+21 KILL DIR,X,Y
+22 SET DIR(0)="SC^1:DIVISION;2:CLINIC;3:PROVIDER;4:STOP CODE;5:DATE;6:PATIENT"
+23 SET DIR("A")="Within "_@SORTARR@("TEXT")_" sort by"
+24 SET DIR("S")="I Y'="_@SORTARR
+25 DO ^DIR
+26 IF $DATA(DIRUT)
KILL @SORTARR
QUIT 0
+27 SET @SORTARR=@SORTARR_"^"_Y
+28 SET @SORTARR@("TEXT")=@SORTARR@("TEXT")_"^"_$$SRT2TXT(Y)
+29 QUIT 1
SRT2TXT(CODE) ;Convert sort code to sort text
+1 ;Input : CODE - Sort code
+2 ;Output : Text for sort code
+3 ;
+4 IF CODE=1
QUIT "division"
+5 IF CODE=2
QUIT "clinic"
+6 IF CODE=3
QUIT "provider"
+7 IF CODE=4
QUIT "stop code"
+8 IF CODE=5
QUIT "date"
+9 IF CODE=6
QUIT "patient"
+10 QUIT ""
+11 ;
ROLLUP(SCRNARR,SORTARR) ;Set screen and sort arrays for national rollup
+1 ;Input : SCRNARR - Screening array
+2 ; SORTARR - Sort array full global reference
+3 ;Output : None
+4 ; Nodes in @SCRNARR are set to denote the following:
+5 ; Time limit of 10
+6 ; Include all divisions
+7 ; Use excluded stop codes from national cohort array
+8 ; Count encounters with scanned progress notes
+9 ; Nodes in @SORTARR are set to denote the following:
+10 ; Primary sort is division
+11 ; Secondary sort is date
+12 ;Note : @SCRNARR and @SORTARR are initialized (KILLed) on input
+13 ;
+14 KILL @SCRNARR,@SORTARR
+15 SET @SCRNARR@("TLMT")=10
+16 SET @SCRNARR@("DIVISION")=1
+17 SET @SCRNARR@("PROVIDERS")=1
+18 DO NTNLESC(SCRNARR)
+19 SET @SCRNARR@("SCANNED")=1
+20 SET @SORTARR="1^5"
+21 SET @SORTARR@("TEXT")="division^date"
+22 QUIT
+23 ;
NTNLSC(SCRNARR) ;Set inclusion array of stop codes for national reporting
+1 ;Input : SCRNARR - Screening array
+2 ;Output : National list of acceptable stop code & credit pairs
+3 ; @SCRNARR@("DSS") = 0
+4 ; @SCRNARR@("DSS-NTNL") = 1
+5 ; @SCRNARR@("DSS",PtrStopCode) = Stop Code Name
+6 ; @SCRNARR@("DSS-PAIR",PtrStopCode,PtrStopCode) = SC Name ^ SC Name
+7 ;
+8 NEW OFF,TEXT,J,CODE,PTR1,TMP,PTR2
+9 SET @SCRNARR@("DSS")=0
+10 SET @SCRNARR@("DSS-NTNL")=1
+11 FOR OFF=1:1
SET TEXT=$PIECE($TEXT(STOP+OFF),";;",2)
if TEXT="END"
QUIT
Begin DoDot:1
+12 FOR J=1:1:$LENGTH(TEXT,"^")
SET CODE=$PIECE(TEXT,"^",J)
Begin DoDot:2
+13 SET TMP=$LENGTH(CODE)
if ((TMP'=3)&(TMP'=6))
QUIT
+14 IF TMP=3
Begin DoDot:3
+15 ;Individual stop code
+16 SET PTR1=$$SC2PTR(CODE)
if 'PTR1
QUIT
+17 SET @SCRNARR@("DSS",+PTR1)=$PIECE(PTR1,"^",2)
End DoDot:3
QUIT
+18 ;Credit pair
+19 SET PTR1=$$SC2PTR($EXTRACT(CODE,1,3))
if 'PTR1
QUIT
+20 SET PTR2=$$SC2PTR($EXTRACT(CODE,4,6))
if 'PTR2
QUIT
+21 SET @SCRNARR@("DSS-PAIR",+PTR1,+PTR2)=$PIECE(PTR1,"^",2)_"^"_$PIECE(PTR2,"^",2)
End DoDot:2
End DoDot:1
+22 QUIT
NTNLESC(SCRNARR) ;Set exclusion array of stop codes for national reporting
+1 ;Input : SCRNARR - Screening array
+2 ;Output : National list of stop codes to be excluded
+3 ; @SCRNARR@("DSS") = 0
+4 ; @SCRNARR@("DSS-NTNL") = 1
+5 ; @SCRNARR@("DSS-EXCLUDE",PtrStopCode) = Stop Code Name
+6 ;
+7 NEW OFF,TEXT,J,CODE,PTR1,TMP,PTR2
+8 SET @SCRNARR@("DSS")=0
+9 SET @SCRNARR@("DSS-NTNL")=1
+10 FOR OFF=1:1
SET TEXT=$PIECE($TEXT(EXCSTOP+OFF),";;",2)
if TEXT="END"
QUIT
Begin DoDot:1
+11 FOR J=1:1:$LENGTH(TEXT,"^")
SET CODE=$PIECE(TEXT,"^",J)
Begin DoDot:2
+12 SET TMP=$LENGTH(CODE)
if ((TMP'=3)&(TMP'=6))
QUIT
+13 IF TMP=3
Begin DoDot:3
+14 ;Individual stop code for exclusion
+15 SET PTR1=$$SC2PTR(CODE)
if 'PTR1
QUIT
+16 SET @SCRNARR@("DSS-EXCLUDE",+PTR1)=$PIECE(PTR1,"^",2)
End DoDot:3
QUIT
End DoDot:2
End DoDot:1
+17 QUIT
RANGE(SCRNARR) ;Screen array by range
+1 NEW DIR,DIRUT,DTOUT,Y,SUB,NODE,CODE,PTR1,J
+2 SET @SCRNARR@("DSS")=0
+3 SET @SCRNARR@("DSS",1)=""
+4 SET @SCRNARR@("DSS-NTNL")=0
+5 SET DIR("A")="Select individual Stop Code or a range of Codes "
+6 SET DIR("?")="This response must be a list or range, e.g., 100,302 or 200-450,800 "
+7 SET DIR(0)="L"
+8 DO ^DIR
+9 IF $DATA(DIRUT)!$DATA(DTOUT)
QUIT
+10 IF Y
Begin DoDot:1
+11 SET FLG=1
+12 SET SUB=""
FOR
SET SUB=$ORDER(Y(SUB))
if SUB=""
QUIT
Begin DoDot:2
+13 SET NODE=(Y(SUB))
+14 FOR J=1:1:$LENGTH(NODE,",")
SET CODE=$PIECE(NODE,",",J)
IF CODE
Begin DoDot:3
+15 SET PTR1=$$SC2PTR(CODE)
if 'PTR1
QUIT
+16 SET @SCRNARR@("DSS",+PTR1)=$PIECE(PTR1,"^",2)
End DoDot:3
End DoDot:2
End DoDot:1
+17 QUIT
SC2PTR(CODE) ;Get pointer to stop code
+1 ;Input : CODE - Stop code
+2 ;Output : Pointer #40.7 ^ Name (#.01)
+3 ;
+4 NEW NODE,PTR
+5 SET PTR=+$ORDER(^DIC(40.7,"C",CODE,0))
IF 'PTR
QUIT "0^INVALID STOP CODE"
+6 SET NODE=$GET(^DIC(40.7,PTR,0))
+7 QUIT PTR_"^"_$PIECE(NODE,"^",1)
+8 ;
STOP ;List of acceptable stop codes and credit pairs
+1 ;;END
+2 ;
EXCSTOP ;Exclusion list of stop codes
+1 ;;104^105^106^107^108^109^115^116^117^120^126^127^128^144^145
+2 ;;146^149^150^151^152^153^154^155^165^166^167^168^169^174^190
+3 ;;202^205^206^207^208^212^213^214^290^291^292^293^294^295^296
+4 ;;321^327^328^329^333^334^370^417^421^422^423^429^430^431^435
+5 ;;450^451^452^453^454^455^456^458^459^460^461^462^463^464^465
+6 ;;466^467^468^469^470^471^472^473^474^475^476^477^478^479^481
+7 ;;482^483^484^485^505^506^510^513^516^519^521^522^523^525^535
+8 ;;538^545^547^550^553^554^557^558^559^560^561^563^564^565^566
+9 ;;573^574^575^577^578^590^602^603^604^606^607^608^610^650^651
+10 ;;652^653^654^655^656^657^660^670^680^681^682^690^691^701^702
+11 ;;703^704^705^706^707^708^709^710^711^725^730^731^900^999
+12 ;;END
+13 ;
