BSDRCLN ;cmi/flag/maw - BSD Print Restricted Clinic List by Division 10/12/2009 2:40:25 PM
;;5.3;PIMS;**1011**;FEB 27,2007;
;
;
;
;this report will list restricted clinics by division
Q
;
MAIN ;EP - this is the main routine driver
S BSDDIV=$$GETDIV()
I '$G(BSDDIV) W !,"You must select a division" D EOJ Q
D LOOP(.BSDRC,BSDDIV)
D PRINT(.BSDRC,BSDDIV)
D EOJ
Q
;
GETDIV() ;-- get the division the user wants
S DIC("A")="Select DIVISION:"
D ASK^SDDIV
I $G(Y)<0 K DIV
Q $G(DIV)
;
LOOP(BSDRC,DV) ;-- loop through the HOSPITAL LOCATION file, screen on DIV and get Restricted Clinic
N BSDDA,BSDATA,BSDDV,BSDRS,BSDCLN,BSDTYP,BSDINS,BSDTYPI
S BSDDA=0 F S BSDDA=$O(^SC(BSDDA)) Q:'BSDDA D
. S BSDATA=$G(^SC(BSDDA,0))
. S BSDDV=$P(BSDATA,U,15)
. Q:BSDDV'=DV
. Q:$P($G(^SC(BSDDA,"SDPROT")),U)'="Y"
. S BSDCLN=$$GET1^DIQ(44,BSDDA,.01)
. S BSDTYPI=$$GET1^DIQ(44,BSDDA,8,"I")
. S BSDTYP=$S(BSDTYPI:$P($G(^DIC(40.7,BSDTYPI,0)),U,2),1:"")
. S BSDINS=$$GET1^DIQ(44,BSDDA,3)
. S BSDRC(BSDDA)=BSDCLN_U_BSDTYP_U_BSDINS
Q
;
PRINT(RC,DV) ;-- print the report
D ^%ZIS
Q:POP
U IO
D XHDR(DV)
N BSDTDA,BSDTDATA,BSDTCLN,BSDTTYP,BSDTINS
S BSDTDA=0 F S BSDTDA=$O(RC(BSDTDA)) Q:BSDTDA=""!($D(DIRUT)) D
. S BSDTDATA=$G(RC(BSDTDA))
. S BSDTCLN=$P(BSDTDATA,U)
. S BSDTTYP=$P(BSDTDATA,U,2)
. S BSDTINS=$P(BSDTDATA,U,3)
. D:$Y+2>IOSL HDR(DV) Q:$G(DIRUT)
. W !,BSDTCLN,?35,BSDTTYP,?55,BSDTINS
Q
;
HDR(ID) ;-- do the charge header
K DIRUT
I $E(IOST,1,1)="C" S DIR(0)="E" D ^DIR
I Y=1 D XHDR(ID) Q
S DIRUT=1
Q
;
XHDR(ID) ;
W @IOF
S ID=$$GET1^DIQ(40.8,ID,.01)
W "Restricted Clinic List by Division: "_ID,?60,"Date: "_$$FMTE^XLFDT(DT)
W !!,"Clinic",?35,"Clinic Code",?55,"Institution"
W !
F I=1:1:80 W "-"
Q
;
EOJ ;-- kill variables and quit
D ^%ZISC
K BSDDIV,BSDRC
Q
;
BSDRCLN ;cmi/flag/maw - BSD Print Restricted Clinic List by Division 10/12/2009 2:40:25 PM
+1 ;;5.3;PIMS;**1011**;FEB 27,2007;
+2 ;
+3 ;
+4 ;
+5 ;this report will list restricted clinics by division
+6 QUIT
+7 ;
MAIN ;EP - this is the main routine driver
+1 SET BSDDIV=$$GETDIV()
+2 IF '$GET(BSDDIV)
WRITE !,"You must select a division"
DO EOJ
QUIT
+3 DO LOOP(.BSDRC,BSDDIV)
+4 DO PRINT(.BSDRC,BSDDIV)
+5 DO EOJ
+6 QUIT
+7 ;
GETDIV() ;-- get the division the user wants
+1 SET DIC("A")="Select DIVISION:"
+2 DO ASK^SDDIV
+3 IF $GET(Y)<0
KILL DIV
+4 QUIT $GET(DIV)
+5 ;
LOOP(BSDRC,DV) ;-- loop through the HOSPITAL LOCATION file, screen on DIV and get Restricted Clinic
+1 NEW BSDDA,BSDATA,BSDDV,BSDRS,BSDCLN,BSDTYP,BSDINS,BSDTYPI
+2 SET BSDDA=0
FOR
SET BSDDA=$ORDER(^SC(BSDDA))
IF 'BSDDA
QUIT
Begin DoDot:1
+3 SET BSDATA=$GET(^SC(BSDDA,0))
+4 SET BSDDV=$PIECE(BSDATA,U,15)
+5 IF BSDDV'=DV
QUIT
+6 IF $PIECE($GET(^SC(BSDDA,"SDPROT")),U)'="Y"
QUIT
+7 SET BSDCLN=$$GET1^DIQ(44,BSDDA,.01)
+8 SET BSDTYPI=$$GET1^DIQ(44,BSDDA,8,"I")
+9 SET BSDTYP=$SELECT(BSDTYPI:$PIECE($GET(^DIC(40.7,BSDTYPI,0)),U,2),1:"")
+10 SET BSDINS=$$GET1^DIQ(44,BSDDA,3)
+11 SET BSDRC(BSDDA)=BSDCLN_U_BSDTYP_U_BSDINS
End DoDot:1
+12 QUIT
+13 ;
PRINT(RC,DV) ;-- print the report
+1 DO ^%ZIS
+2 IF POP
QUIT
+3 USE IO
+4 DO XHDR(DV)
+5 NEW BSDTDA,BSDTDATA,BSDTCLN,BSDTTYP,BSDTINS
+6 SET BSDTDA=0
FOR
SET BSDTDA=$ORDER(RC(BSDTDA))
IF BSDTDA=""!($DATA(DIRUT))
QUIT
Begin DoDot:1
+7 SET BSDTDATA=$GET(RC(BSDTDA))
+8 SET BSDTCLN=$PIECE(BSDTDATA,U)
+9 SET BSDTTYP=$PIECE(BSDTDATA,U,2)
+10 SET BSDTINS=$PIECE(BSDTDATA,U,3)
+11 IF $Y+2>IOSL
DO HDR(DV)
IF $GET(DIRUT)
QUIT
+12 WRITE !,BSDTCLN,?35,BSDTTYP,?55,BSDTINS
End DoDot:1
+13 QUIT
+14 ;
HDR(ID) ;-- do the charge header
+1 KILL DIRUT
+2 IF $EXTRACT(IOST,1,1)="C"
SET DIR(0)="E"
DO ^DIR
+3 IF Y=1
DO XHDR(ID)
QUIT
+4 SET DIRUT=1
+5 QUIT
+6 ;
XHDR(ID) ;
+1 WRITE @IOF
+2 SET ID=$$GET1^DIQ(40.8,ID,.01)
+3 WRITE "Restricted Clinic List by Division: "_ID,?60,"Date: "_$$FMTE^XLFDT(DT)
+4 WRITE !!,"Clinic",?35,"Clinic Code",?55,"Institution"
+5 WRITE !
+6 FOR I=1:1:80
WRITE "-"
+7 QUIT
+8 ;
EOJ ;-- kill variables and quit
+1 DO ^%ZISC
+2 KILL BSDDIV,BSDRC
+3 QUIT
+4 ;
