BSDCVC.m

BSDCVC ; IHS/ANMC/LJF - LIST VISIT CREATION STATUS ; 

 ;;5.3;PIMS;;APR 26, 2002

 ;

 NEW VAUTC,VAUTD

 D CLINIC^BSDU(2) Q:$D(BSDQ)

 I $$BROWSE^BDGF="B" D EN Q

 D ZIS^BDGF("PQ","EN^BSDCVC","LIST VISIT CREATE STATUS","")

 Q

 ;

EN ;EP; -- main entry point for BSDRM CREATE VISIT STATUS

 I $E(IOST,1,2)="P-" NEW BSDPRT S BSDPRT=1 D INIT,PRINT Q  ;prnt 2 paper

 NEW VALMCNT D TERM^VALM0,CLEAR^VALM1

 D EN^VALM("BSDRM CREATE VISIT STATUS")

 D CLEAR^VALM1

 Q

 ;

HDR ; -- header code

 NEW X S X="Sorted by Status & Principal Clinic"

 S VALMHDR(1)=$$SP(79-$L(X)\2)_X

 Q

 ;

INIT ; -- init variables and list array

 NEW CLN,STAT,PC,LINE

 S VALMCNT=0

 K ^TMP("BSDCVC",$J),^TMP("BSDCVC1",$J)

 S ARRAY=$S(VAUTC:"^SC",1:"VAUTC")

 ;

 ; loop thru clinics and sort by visit creation status & princpl clinic

 S CLN=0 F  S CLN=$O(@ARRAY@(CLN)) Q:'CLN  D

 . Q:'$$ACTV^BSDU(CLN,DT)                  ;check if active clinic

 . Q:$D(^SC("AIHSPC",CLN))                 ;quit if prin clinic

 . S STAT=$$GET1^DIQ(9009017.2,CLN,.09)    ;create visit?

 . S:STAT="" STAT="NO"

 . S ^TMP("BSDCVC1",$J,STAT,$$PRIN^BSDU(CLN),CLN)=""

 ;

 ; now loop thru sort list and put into display array

 S STAT=0 F  S STAT=$O(^TMP("BSDCVC1",$J,STAT)) Q:STAT=""  D

 . ;

 . S LINE="CLINICS WITH 'CREATE VISIT AT CHECKIN' TURNED "

 . S LINE=LINE_$S(STAT="NO":"OFF",1:"ON")

 . S LINE=$$SP(79-$L(LINE)\2)_$G(IORVON)_LINE_$G(IORVOFF)

 . I $G(BSDPRT),STAT="YES" D SET("*****",.VALMCNT)   ;form feed marker

 . D SET("",.VALMCNT),SET(LINE,.VALMCNT)

 . ;

 . S PC=0 F  S PC=$O(^TMP("BSDCVC1",$J,STAT,PC)) Q:PC=""  D

 .. ;

 .. D SET("",.VALMCNT),SET($G(IOUON)_PC_$G(IOUOFF),.VALMCNT)

 .. ;

 .. S CLN=0 F  S CLN=$O(^TMP("BSDCVC1",$J,STAT,PC,CLN)) Q:'CLN  D

 ... ;

 ... S LINE=$$SP(3)_$$GET1^DIQ(44,CLN,.01)                ;clinic name

 ... S LINE=$$PAD(LINE,35)_$P($$CLNCODE^BSDU(CLN),"-")    ;clinic code

 ... S LINE=$$PAD(LINE,41)_$$GET1^DIQ(9009017.2,CLN,.13)  ;other codes?

 ... S LINE=$$PAD(LINE,49)_$$GET1^DIQ(9009017.2,CLN,.12,"I")  ;ser cat

 ... S X=$$PRV^BSDU(CLN),X=$S('X:"",1:$P(X,U,2))

 ... S LINE=$$PAD(LINE,55)_$E(X,1,18)                  ;clinic provider

 ... S LINE=$$PAD(LINE,75)_$$GET1^DIQ(9009017.2,CLN,.14)  ;prov req?

 ... D SET(LINE,.VALMCNT)

 ;

 I $D(^TMP("BSDCVC",$J)) D LEGEND

 I '$D(^TMP("BSDCVC",$J)) S VALMCNT=1,^TMP("BSDCVC",$J,1,0)="NO DATA FOUND"

 ;

 K ^TMP("BSDCVC1",$J)

 Q

 ;

SET(DATA,NUM) ; put display line into array

 S NUM=NUM+1

 S ^TMP("BSDCVC",$J,NUM,0)=DATA

 Q

 ;

HELP ; -- help code

 S X="?" D DISP^XQORM1 W !!

 Q

 ;

EXIT ; -- exit code

 K ^TMP("BSDCVC",$J)

 Q

 ;

EXPND ; -- expand code

 Q

 ;

LEGEND ; explain column headings

 D SET("",.VALMCNT),SET("LEGEND:",.VALMCNT)

 D SET($$SP(3)_"Code=Clinic Code; Mult=Multiple Codes Used?",.VALMCNT)

 D SET($$SP(3)_"Vst Cat=Visit Service Category, optional",.VALMCNT)

 D SET($$SP(3)_"Req?=Is Visit Provider Required?",.VALMCNT)

 Q

 ;

PRINT ; print array to paper

 NEW BSDLN,BSDN,BDGPG

 U IO D INIT^BDGF,HDG

 ;

 S BSDLN=0 F  S BSDLN=$O(^TMP("BSDCVC",$J,BSDLN)) Q:'BSDLN  D

 . S BSDN=^TMP("BSDCVC",$J,BSDLN,0)

 . I BSDN="*****" D HDG Q

 . I $Y>(IOSL-4) D HDG

 . W !,BSDN

 D ^%ZISC,PRTKL^BDGF,EXIT

 Q

 ;

HDG ; heading when printing to paper

 S BDGPG=$G(BDGPG)+1 I BDGPG>1 W @IOF

 W !,BDGTIME,?22,"List 'Create Visit at Checkin' Status",?76,BDGUSR

 W !,BDGDATE,?23,"Sorted by Status & Principal Clinic"

 W ?71,"Page: ",BDGPG

 W !,$$REPEAT^XLFSTR("-",80)

 W !?3,"Clinic Name",?35,"Code",?41,"Mult",?46,"Vst Cat"

 W ?55,"Clinic Provider",?75,"Req?"

 W !,$$REPEAT^XLFSTR("=",80)

 Q

 ;

PAD(D,L) ;EP -- SUBRTN to pad length of data

 ; -- D=data L=length

 Q $E(D_$$REPEAT^XLFSTR(" ",L),1,L)

 ;

SP(N) ; -- SUBRTN to pad N number of spaces

 Q $$PAD(" ",N)

BSDCVC    ; IHS/ANMC/LJF - LIST VISIT CREATION STATUS ; 

 +1       ;;5.3;PIMS;;APR 26, 2002

 +2       ;

 +3        NEW VAUTC,VAUTD

 +4        DO CLINIC^BSDU(2)

           IF $DATA(BSDQ)

               QUIT 

 +5        IF $$BROWSE^BDGF="B"

               DO EN

               QUIT 

 +6        DO ZIS^BDGF("PQ","EN^BSDCVC","LIST VISIT CREATE STATUS","")

 +7        QUIT 

 +8       ;

EN        ;EP; -- main entry point for BSDRM CREATE VISIT STATUS

 +1       ;prnt 2 paper

           IF $EXTRACT(IOST,1,2)="P-"

               NEW BSDPRT

               SET BSDPRT=1

               DO INIT

               DO PRINT

               QUIT 

 +2        NEW VALMCNT

           DO TERM^VALM0

           DO CLEAR^VALM1

 +3        DO EN^VALM("BSDRM CREATE VISIT STATUS")

 +4        DO CLEAR^VALM1

 +5        QUIT 

 +6       ;

HDR       ; -- header code

 +1        NEW X

           SET X="Sorted by Status & Principal Clinic"

 +2        SET VALMHDR(1)=$$SP(79-$LENGTH(X)\2)_X

 +3        QUIT 

 +4       ;

INIT      ; -- init variables and list array

 +1        NEW CLN,STAT,PC,LINE

 +2        SET VALMCNT=0

 +3        KILL ^TMP("BSDCVC",$JOB),^TMP("BSDCVC1",$JOB)

 +4        SET ARRAY=$SELECT(VAUTC:"^SC",1:"VAUTC")

 +5       ;

 +6       ; loop thru clinics and sort by visit creation status & princpl clinic

 +7        SET CLN=0

           FOR 

               SET CLN=$ORDER(@ARRAY@(CLN))

               IF 'CLN

                   QUIT 

               Begin DoDot:1

 +8       ;check if active clinic

                   IF '$$ACTV^BSDU(CLN,DT)

                       QUIT 

 +9       ;quit if prin clinic

                   IF $DATA(^SC("AIHSPC",CLN))

                       QUIT 

 +10      ;create visit?

                   SET STAT=$$GET1^DIQ(9009017.2,CLN,.09)

 +11               IF STAT=""

                       SET STAT="NO"

 +12               SET ^TMP("BSDCVC1",$JOB,STAT,$$PRIN^BSDU(CLN),CLN)=""

               End DoDot:1

 +13      ;

 +14      ; now loop thru sort list and put into display array

 +15       SET STAT=0

           FOR 

               SET STAT=$ORDER(^TMP("BSDCVC1",$JOB,STAT))

               IF STAT=""

                   QUIT 

               Begin DoDot:1

 +16      ;

 +17               SET LINE="CLINICS WITH 'CREATE VISIT AT CHECKIN' TURNED "

 +18               SET LINE=LINE_$SELECT(STAT="NO":"OFF",1:"ON")

 +19               SET LINE=$$SP(79-$LENGTH(LINE)\2)_$GET(IORVON)_LINE_$GET(IORVOFF)

 +20      ;form feed marker

                   IF $GET(BSDPRT)

                       IF STAT="YES"

                           DO SET("*****",.VALMCNT)

 +21               DO SET("",.VALMCNT)

                   DO SET(LINE,.VALMCNT)

 +22      ;

 +23               SET PC=0

                   FOR 

                       SET PC=$ORDER(^TMP("BSDCVC1",$JOB,STAT,PC))

                       IF PC=""

                           QUIT 

                       Begin DoDot:2

 +24      ;

 +25                       DO SET("",.VALMCNT)

                           DO SET($GET(IOUON)_PC_$GET(IOUOFF),.VALMCNT)

 +26      ;

 +27                       SET CLN=0

                           FOR 

                               SET CLN=$ORDER(^TMP("BSDCVC1",$JOB,STAT,PC,CLN))

                               IF 'CLN

                                   QUIT 

                               Begin DoDot:3

 +28      ;

 +29      ;clinic name

                                   SET LINE=$$SP(3)_$$GET1^DIQ(44,CLN,.01)

 +30      ;clinic code

                                   SET LINE=$$PAD(LINE,35)_$PIECE($$CLNCODE^BSDU(CLN),"-")

 +31      ;other codes?

                                   SET LINE=$$PAD(LINE,41)_$$GET1^DIQ(9009017.2,CLN,.13)

 +32      ;ser cat

                                   SET LINE=$$PAD(LINE,49)_$$GET1^DIQ(9009017.2,CLN,.12,"I")

 +33                               SET X=$$PRV^BSDU(CLN)

                                   SET X=$SELECT('X:"",1:$PIECE(X,U,2))

 +34      ;clinic provider

                                   SET LINE=$$PAD(LINE,55)_$EXTRACT(X,1,18)

 +35      ;prov req?

                                   SET LINE=$$PAD(LINE,75)_$$GET1^DIQ(9009017.2,CLN,.14)

 +36                               DO SET(LINE,.VALMCNT)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +37      ;

 +38       IF $DATA(^TMP("BSDCVC",$JOB))

               DO LEGEND

 +39       IF '$DATA(^TMP("BSDCVC",$JOB))

               SET VALMCNT=1

               SET ^TMP("BSDCVC",$JOB,1,0)="NO DATA FOUND"

 +40      ;

 +41       KILL ^TMP("BSDCVC1",$JOB)

 +42       QUIT 

 +43      ;

SET(DATA,NUM) ; put display line into array

 +1        SET NUM=NUM+1

 +2        SET ^TMP("BSDCVC",$JOB,NUM,0)=DATA

 +3        QUIT 

 +4       ;

HELP      ; -- help code

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !!

 +2        QUIT 

 +3       ;

EXIT      ; -- exit code

 +1        KILL ^TMP("BSDCVC",$JOB)

 +2        QUIT 

 +3       ;

EXPND     ; -- expand code

 +1        QUIT 

 +2       ;

LEGEND    ; explain column headings

 +1        DO SET("",.VALMCNT)

           DO SET("LEGEND:",.VALMCNT)

 +2        DO SET($$SP(3)_"Code=Clinic Code; Mult=Multiple Codes Used?",.VALMCNT)

 +3        DO SET($$SP(3)_"Vst Cat=Visit Service Category, optional",.VALMCNT)

 +4        DO SET($$SP(3)_"Req?=Is Visit Provider Required?",.VALMCNT)

 +5        QUIT 

 +6       ;

PRINT     ; print array to paper

 +1        NEW BSDLN,BSDN,BDGPG

 +2        USE IO

           DO INIT^BDGF

           DO HDG

 +3       ;

 +4        SET BSDLN=0

           FOR 

               SET BSDLN=$ORDER(^TMP("BSDCVC",$JOB,BSDLN))

               IF 'BSDLN

                   QUIT 

               Begin DoDot:1

 +5                SET BSDN=^TMP("BSDCVC",$JOB,BSDLN,0)

 +6                IF BSDN="*****"

                       DO HDG

                       QUIT 

 +7                IF $Y>(IOSL-4)

                       DO HDG

 +8                WRITE !,BSDN

               End DoDot:1

 +9        DO ^%ZISC

           DO PRTKL^BDGF

           DO EXIT

 +10       QUIT 

 +11      ;

HDG       ; heading when printing to paper

 +1        SET BDGPG=$GET(BDGPG)+1

           IF BDGPG>1

               WRITE @IOF

 +2        WRITE !,BDGTIME,?22,"List 'Create Visit at Checkin' Status",?76,BDGUSR

 +3        WRITE !,BDGDATE,?23,"Sorted by Status & Principal Clinic"

 +4        WRITE ?71,"Page: ",BDGPG

 +5        WRITE !,$$REPEAT^XLFSTR("-",80)

 +6        WRITE !?3,"Clinic Name",?35,"Code",?41,"Mult",?46,"Vst Cat"

 +7        WRITE ?55,"Clinic Provider",?75,"Req?"

 +8        WRITE !,$$REPEAT^XLFSTR("=",80)

 +9        QUIT 

 +10      ;

PAD(D,L)  ;EP -- SUBRTN to pad length of data

 +1       ; -- D=data L=length

 +2        QUIT $EXTRACT(D_$$REPEAT^XLFSTR(" ",L),1,L)

 +3       ;

SP(N)     ; -- SUBRTN to pad N number of spaces

 +1        QUIT $$PAD(" ",N)