Routine: SCRPIUT1

SCRPIUT1 ; ALB/SCK - Incomplete Encounter Mgmt Report Utilities ; 20 Nov 98 12:36 AM

 ;;5.3;Scheduling;**66,147,154,1015**;AUG 13, 1993;Build 21

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

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))

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

SCRPIUT1  ; ALB/SCK - Incomplete Encounter Mgmt Report Utilities ; 20 Nov 98 12:36 AM

 +1       ;;5.3;Scheduling;**66,147,154,1015**;AUG 13, 1993;Build 21

 +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

SCRPIUT1.m