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)
