BDGSPTR ;cmi/anch/maw - BDG Sensitive Patient Tracking Report 6/3/2009 2:17:08 PM
;;5.3;PIMS;**1010,1011**;MAY 28, 2004
;
;
;
;
MAIN ;-- this is the main routine driver
N BDGSPTS,BDGINDX
S BDGSPTS=$$SORT()
I $G(BDGSPTS)="" Q
I BDGSPTS="S" S BDGSS=$$S()
I BDGSPTS="S",+$G(BDGSS)<0 Q
D LOOP(BDGSPTS)
D PRINT(BDGSPTS)
D EOJ
Q
;
SORT() ;-- ask the sort for the report
S DIR(0)="S^M:MAIL CODE;S:SERVICE SECTION",DIR("A")="Sort By ",DIR("B")="M"
D ^DIR
I Y=U Q ""
S BDGSPTSE=Y(0)
Q Y
;
S() ;-- get service section
S DIC=49,DIC(0)="AEMQZ",DIC("A")="Service/Section: "
D ^DIC
I 'Y Q ""
Q +Y
;
LOOP(IDX) ;-- loop through the new person file
N BDGDA
S BDGDA=0 F S BDGDA=$O(^BDGSPT("B",BDGDA)) Q:'BDGDA D
. N BDGIEN
. S BDGIEN=0 F S BDGIEN=$O(^BDGSPT("B",BDGDA,BDGIEN)) Q:'BDGIEN D
.. N BDGNM,BDGSSE,BDGMC,BDGI
.. S BDGI=$P($G(^BDGSPT(BDGIEN,0)),U)
.. S BDGNM=$P($G(^VA(200,BDGI,0)),U)
.. S BDGSSE=$$GET1^DIQ(200,BDGI,29)
.. I BDGSSE="" S BDGSSE="N/A"
.. S BDGMC=$$GET1^DIQ(200,BDGI,28)
.. I BDGMC="" S BDGMC="N/A"
.. S ^TMP("BDGSPT",$J,$S(IDX="S":BDGSSE,1:BDGMC),BDGNM)=$S(IDX="S":BDGMC,1:BDGSSE)
Q
;
PRINT(IDX) ;-- print the report
D ^%ZIS
Q:POP
U IO
D XHDR(IDX)
N BDGTDA
S BDGTDA=0 F S BDGTDA=$O(^TMP("BDGSPT",$J,BDGTDA)) Q:BDGTDA="" D
. N BDGTIEN
. S BDGTIEN=0 F S BDGTIEN=$O(^TMP("BDGSPT",$J,BDGTDA,BDGTIEN)) Q:BDGTIEN="" D
.. N BDGDATA,BDGTSS,BDGTMC
.. S BDGDATA=$G(^TMP("BDGSPT",$J,BDGTDA,BDGTIEN))
.. S BDGTMC=$P(BDGDATA,U)
.. D:$Y+2>IOSL HDR(IDX) Q:$G(DIRUT)
.. W !,BDGTIEN,?35,BDGTDA,?55,BDGTMC
Q
;
HDR(ID) ;-- do the charge header
K DIRUT
I $E(IOST,1,1)="C" S DIR(0)="E" D ^DIR I Y<1 S DIRUT=1 Q
XHDR(ID) W @IOF
W "Sensitive Patient Tracking - Users Access by "_BDGSPTSE,?60,"Date: "_$$FMTE^XLFDT(DT)
W !!,"Name",?35,$S(ID="S":"Service Section",1:"Mail Code"),?55,$S(ID="S":"Mail Code",1:"Service/Section")
W !
F I=1:1:80 W "-"
Q
;
EOJ ;-- kill variables
D ^%ZISC
K BDGSPTSE
K ^TMP("BDGSPT",$J)
Q
;
BDGSPTR ;cmi/anch/maw - BDG Sensitive Patient Tracking Report 6/3/2009 2:17:08 PM
+1 ;;5.3;PIMS;**1010,1011**;MAY 28, 2004
+2 ;
+3 ;
+4 ;
+5 ;
MAIN ;-- this is the main routine driver
+1 NEW BDGSPTS,BDGINDX
+2 SET BDGSPTS=$$SORT()
+3 IF $GET(BDGSPTS)=""
QUIT
+4 IF BDGSPTS="S"
SET BDGSS=$$S()
+5 IF BDGSPTS="S"
IF +$GET(BDGSS)<0
QUIT
+6 DO LOOP(BDGSPTS)
+7 DO PRINT(BDGSPTS)
+8 DO EOJ
+9 QUIT
+10 ;
SORT() ;-- ask the sort for the report
+1 SET DIR(0)="S^M:MAIL CODE;S:SERVICE SECTION"
SET DIR("A")="Sort By "
SET DIR("B")="M"
+2 DO ^DIR
+3 IF Y=U
QUIT ""
+4 SET BDGSPTSE=Y(0)
+5 QUIT Y
+6 ;
S() ;-- get service section
+1 SET DIC=49
SET DIC(0)="AEMQZ"
SET DIC("A")="Service/Section: "
+2 DO ^DIC
+3 IF 'Y
QUIT ""
+4 QUIT +Y
+5 ;
LOOP(IDX) ;-- loop through the new person file
+1 NEW BDGDA
+2 SET BDGDA=0
FOR
SET BDGDA=$ORDER(^BDGSPT("B",BDGDA))
IF 'BDGDA
QUIT
Begin DoDot:1
+3 NEW BDGIEN
+4 SET BDGIEN=0
FOR
SET BDGIEN=$ORDER(^BDGSPT("B",BDGDA,BDGIEN))
IF 'BDGIEN
QUIT
Begin DoDot:2
+5 NEW BDGNM,BDGSSE,BDGMC,BDGI
+6 SET BDGI=$PIECE($GET(^BDGSPT(BDGIEN,0)),U)
+7 SET BDGNM=$PIECE($GET(^VA(200,BDGI,0)),U)
+8 SET BDGSSE=$$GET1^DIQ(200,BDGI,29)
+9 IF BDGSSE=""
SET BDGSSE="N/A"
+10 SET BDGMC=$$GET1^DIQ(200,BDGI,28)
+11 IF BDGMC=""
SET BDGMC="N/A"
+12 SET ^TMP("BDGSPT",$JOB,$SELECT(IDX="S":BDGSSE,1:BDGMC),BDGNM)=$SELECT(IDX="S":BDGMC,1:BDGSSE)
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
PRINT(IDX) ;-- print the report
+1 DO ^%ZIS
+2 IF POP
QUIT
+3 USE IO
+4 DO XHDR(IDX)
+5 NEW BDGTDA
+6 SET BDGTDA=0
FOR
SET BDGTDA=$ORDER(^TMP("BDGSPT",$JOB,BDGTDA))
IF BDGTDA=""
QUIT
Begin DoDot:1
+7 NEW BDGTIEN
+8 SET BDGTIEN=0
FOR
SET BDGTIEN=$ORDER(^TMP("BDGSPT",$JOB,BDGTDA,BDGTIEN))
IF BDGTIEN=""
QUIT
Begin DoDot:2
+9 NEW BDGDATA,BDGTSS,BDGTMC
+10 SET BDGDATA=$GET(^TMP("BDGSPT",$JOB,BDGTDA,BDGTIEN))
+11 SET BDGTMC=$PIECE(BDGDATA,U)
+12 IF $Y+2>IOSL
DO HDR(IDX)
IF $GET(DIRUT)
QUIT
+13 WRITE !,BDGTIEN,?35,BDGTDA,?55,BDGTMC
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
HDR(ID) ;-- do the charge header
+1 KILL DIRUT
+2 IF $EXTRACT(IOST,1,1)="C"
SET DIR(0)="E"
DO ^DIR
IF Y<1
SET DIRUT=1
QUIT
XHDR(ID) WRITE @IOF
+1 WRITE "Sensitive Patient Tracking - Users Access by "_BDGSPTSE,?60,"Date: "_$$FMTE^XLFDT(DT)
+2 WRITE !!,"Name",?35,$SELECT(ID="S":"Service Section",1:"Mail Code"),?55,$SELECT(ID="S":"Mail Code",1:"Service/Section")
+3 WRITE !
+4 FOR I=1:1:80
WRITE "-"
+5 QUIT
+6 ;
EOJ ;-- kill variables
+1 DO ^%ZISC
+2 KILL BDGSPTSE
+3 KILL ^TMP("BDGSPT",$JOB)
+4 QUIT
+5 ;
