SCRPIUT1 ; ALB/SCK - Incomplete Encounter Mgmt Report Utilities ; 20 Nov 98 12:36 AM
;;5.3;Scheduling;**66,147,154**;AUG 13, 1993
;
Q
DIV() ; Returns either list of selected divisions for multi-divisional site, or primary
; division for single division site.
;
N Y
I $P($G(^DG(43,1,"GL")),U,2) D
. W !
. D DIVISION^VAUTOMA
E D
. S VAUTD=0
. S Y=$$PRIM^VASITE
. S VAUTD(Y)=$P($G(^DG(40.8,Y,0)),U)
;
Q Y
;
CLN() ; Select One/Many/All Clinics for selected Division
N Y
S VAUTNI=2
W !
D CLINIC^VAUTOMA
Q Y
;
CTR(X,SDLW) ; Center string x in display line
N SDL
I '$G(SDLW) S SDLW=80
S SDL=(SDLW-$L(X))/2
S X=$$SPACE(SDL)_X
Q
;
SPACE(SCWDTH) ; Build string of 'SCWDTH' spaces
; Variable Input
; SCWDTH - returns with formatted string
;
; Return
; TAB - "spaces" to tab over
;
N TAB S TAB=""
S $P(TAB," ",SCWDTH)=""
Q TAB
;
PARSE(ER,ER1,ER2,PB,PE) ; Parse error description into two lines for report
N SCX
F SCX=PB:1:PE I $E(ER,SCX)=" " D Q
. S ER1=$E(ER,1,SCX),ER2=$E(ER,SCX+1,$L(ER))
;
S ER1=$E(ER,1,PE),ER2=$E(ER,PE+1,$L(ER))
Q
;
ERRLST ;
N SDIV,SDERR,DIR,DIRUT,DTOUT,DUOUT
I $P($G(^DG(43,1,"GL")),U,2) D Q:Y<0
. S DIR(0)="YA",DIR("B")="YES",DIR("A")="Select All Divisions? "
. D ^DIR K DIR Q:$D(DIRUT)
. I Y S SDIV="" Q
. S DIC=40.8,DIC(0)="AEQMZ"
. S DIC("A")="Enter Division for Errors: "
. S DIC("B")=$P($G(^DG(40.8,$$PRIM^VASITE($$NOW^XLFDT),0)),U)
. D ^DIC K DIC I +Y>0 S SDIV=+Y
E D
. S SDIV=""
;
Q:$D(DIRUT)
;
S DIR(0)="YA",DIR("B")="YES",DIR("A")="Select all Errors? "
D ^DIR K DIR Q:$D(DIRUT)
;
I Y S SDERR=""
E D Q:$D(DTOUT)!($D(DUOUT))!(Y'>0)
. S DIC=409.76,DIC(0)="AEQMZ",DIC("A")="Select Error Code: "
. D ^DIC K DIC Q:$D(DTOUT)!($D(DUOUT))!(Y'>0)
. S SDERR=Y(0,0)
;
S L=0
S DIC=409.75
S FLDS="[SCENI ERROR LIST]"
S BY="[SCENI ERROR SORT]"
S FR=SDIV_",,"_SDERR_","
S TO=SDIV_",,"_SDERR_","
S DISUPNO=0
D EN1^DIP
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCRPIUT1 2008 printed Nov 22, 2024@17:52:32 Page 2
SCRPIUT1 ; ALB/SCK - Incomplete Encounter Mgmt Report Utilities ; 20 Nov 98 12:36 AM
+1 ;;5.3;Scheduling;**66,147,154**;AUG 13, 1993
+2 ;
+3 QUIT
DIV() ; Returns either list of selected divisions for multi-divisional site, or primary
+1 ; division for single division site.
+2 ;
+3 NEW Y
+4 IF $PIECE($GET(^DG(43,1,"GL")),U,2)
Begin DoDot:1
+5 WRITE !
+6 DO DIVISION^VAUTOMA
End DoDot:1
+7 IF '$TEST
Begin DoDot:1
+8 SET VAUTD=0
+9 SET Y=$$PRIM^VASITE
+10 SET VAUTD(Y)=$PIECE($GET(^DG(40.8,Y,0)),U)
End DoDot:1
+11 ;
+12 QUIT Y
+13 ;
CLN() ; Select One/Many/All Clinics for selected Division
+1 NEW Y
+2 SET VAUTNI=2
+3 WRITE !
+4 DO CLINIC^VAUTOMA
+5 QUIT Y
+6 ;
CTR(X,SDLW) ; Center string x in display line
+1 NEW SDL
+2 IF '$GET(SDLW)
SET SDLW=80
+3 SET SDL=(SDLW-$LENGTH(X))/2
+4 SET X=$$SPACE(SDL)_X
+5 QUIT
+6 ;
SPACE(SCWDTH) ; Build string of 'SCWDTH' spaces
+1 ; Variable Input
+2 ; SCWDTH - returns with formatted string
+3 ;
+4 ; Return
+5 ; TAB - "spaces" to tab over
+6 ;
+7 NEW TAB
SET TAB=""
+8 SET $PIECE(TAB," ",SCWDTH)=""
+9 QUIT TAB
+10 ;
PARSE(ER,ER1,ER2,PB,PE) ; Parse error description into two lines for report
+1 NEW SCX
+2 FOR SCX=PB:1:PE
IF $EXTRACT(ER,SCX)=" "
Begin DoDot:1
+3 SET ER1=$EXTRACT(ER,1,SCX)
SET ER2=$EXTRACT(ER,SCX+1,$LENGTH(ER))
End DoDot:1
QUIT
+4 ;
+5 SET ER1=$EXTRACT(ER,1,PE)
SET ER2=$EXTRACT(ER,PE+1,$LENGTH(ER))
+6 QUIT
+7 ;
ERRLST ;
+1 NEW SDIV,SDERR,DIR,DIRUT,DTOUT,DUOUT
+2 IF $PIECE($GET(^DG(43,1,"GL")),U,2)
Begin DoDot:1
+3 SET DIR(0)="YA"
SET DIR("B")="YES"
SET DIR("A")="Select All Divisions? "
+4 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+5 IF Y
SET SDIV=""
QUIT
+6 SET DIC=40.8
SET DIC(0)="AEQMZ"
+7 SET DIC("A")="Enter Division for Errors: "
+8 SET DIC("B")=$PIECE($GET(^DG(40.8,$$PRIM^VASITE($$NOW^XLFDT),0)),U)
+9 DO ^DIC
KILL DIC
IF +Y>0
SET SDIV=+Y
End DoDot:1
if Y<0
QUIT
+10 IF '$TEST
Begin DoDot:1
+11 SET SDIV=""
End DoDot:1
+12 ;
+13 if $DATA(DIRUT)
QUIT
+14 ;
+15 SET DIR(0)="YA"
SET DIR("B")="YES"
SET DIR("A")="Select all Errors? "
+16 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+17 ;
+18 IF Y
SET SDERR=""
+19 IF '$TEST
Begin DoDot:1
+20 SET DIC=409.76
SET DIC(0)="AEQMZ"
SET DIC("A")="Select Error Code: "
+21 DO ^DIC
KILL DIC
if $DATA(DTOUT)!($DATA(DUOUT))!(Y'>0)
QUIT
+22 SET SDERR=Y(0,0)
End DoDot:1
if $DATA(DTOUT)!($DATA(DUOUT))!(Y'>0)
QUIT
+23 ;
+24 SET L=0
+25 SET DIC=409.75
+26 SET FLDS="[SCENI ERROR LIST]"
+27 SET BY="[SCENI ERROR SORT]"
+28 SET FR=SDIV_",,"_SDERR_","
+29 SET TO=SDIV_",,"_SDERR_","
+30 SET DISUPNO=0
+31 DO EN1^DIP
+32 QUIT
