BSDTLBP.m

BSDTLBP ;ihs/cmi/maw - BSD Track Letters By Patient 5/3/2011 1:23:57 PM

 ;;5.3;PIMS;**1013**;APR 26, 2002

 ;

 ;

MAIN ;-- this is the main routine driver

 N PAT

 S PAT=$$PAT

 Q:'$G(PAT)

 D ZIS^DGUTQ

 D LET(PAT)

 U IO

 D HDR(PAT)

 D PRT

 D XIT

 Q

 ;

PAT() ;-- get the patient

 S DIC(0)="AEMQZ",DIC="^AUPNPAT(",DIC("A")="Select Patient: "

 D ^DIC

 Q +Y

 ;

LET(P) ;-- get the letter to print

 N BDA,CDA,CNT,DLP

 S BDA=0 F  S BDA=$O(^VA(407.5,"BTRK",P,BDA)) Q:'BDA  D

 . S CNT=0

 . S:'$D(LET(P)) LET(P)=0

 . S CDA=0 F  S CDA=$O(^VA(407.5,"BTRK",P,BDA,CDA)) Q:'CDA  D

 .. S CNT=CNT+1

 .. S DLP=$P($G(^VA(407.5,BDA,"PIHS",CDA,0)),U,2)

 .. S LET(BDA)=DLP_U_CNT

 Q

 ;

PRT ;-- lets print the report

 N LETE,DDA,DLPE,NT

 S DDA=0 F  S DDA=$O(LET(DDA)) Q:'DDA  D

 . S LETE=$P($G(^VA(407.5,DDA,0)),U)

 . Q:$G(LETE)=""

 . S DLPE=$$FMTE^XLFDT($P($G(LET(DDA)),U))

 . S NT=$P($G(LET(DDA)),U,2)

 . W !,LETE,?30,DLPE,?60,NT

 Q

 ;

HDR(P) ;-- Get the header

 W !,"Patient Letter Tracking for: "_$P($G(^DPT(P,0)),U),?55,"Date Printed: "_DT

 W !!,"Letter",?30,"Last Date Printed",?60,"Number of times",!

 F I=1:1:80 W "-"

 Q

 ;

XIT ;-- exit and quit

 D ^%ZISC

 K LET

 Q

 ;

BSDTLBP   ;ihs/cmi/maw - BSD Track Letters By Patient 5/3/2011 1:23:57 PM

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

 +2       ;

 +3       ;

MAIN      ;-- this is the main routine driver

 +1        NEW PAT

 +2        SET PAT=$$PAT

 +3        IF '$GET(PAT)

               QUIT 

 +4        DO ZIS^DGUTQ

 +5        DO LET(PAT)

 +6        USE IO

 +7        DO HDR(PAT)

 +8        DO PRT

 +9        DO XIT

 +10       QUIT 

 +11      ;

PAT()     ;-- get the patient

 +1        SET DIC(0)="AEMQZ"

           SET DIC="^AUPNPAT("

           SET DIC("A")="Select Patient: "

 +2        DO ^DIC

 +3        QUIT +Y

 +4       ;

LET(P)    ;-- get the letter to print

 +1        NEW BDA,CDA,CNT,DLP

 +2        SET BDA=0

           FOR 

               SET BDA=$ORDER(^VA(407.5,"BTRK",P,BDA))

               IF 'BDA

                   QUIT 

               Begin DoDot:1

 +3                SET CNT=0

 +4                IF '$DATA(LET(P))

                       SET LET(P)=0

 +5                SET CDA=0

                   FOR 

                       SET CDA=$ORDER(^VA(407.5,"BTRK",P,BDA,CDA))

                       IF 'CDA

                           QUIT 

                       Begin DoDot:2

 +6                        SET CNT=CNT+1

 +7                        SET DLP=$PIECE($GET(^VA(407.5,BDA,"PIHS",CDA,0)),U,2)

 +8                        SET LET(BDA)=DLP_U_CNT

                       End DoDot:2

               End DoDot:1

 +9        QUIT 

 +10      ;

PRT       ;-- lets print the report

 +1        NEW LETE,DDA,DLPE,NT

 +2        SET DDA=0

           FOR 

               SET DDA=$ORDER(LET(DDA))

               IF 'DDA

                   QUIT 

               Begin DoDot:1

 +3                SET LETE=$PIECE($GET(^VA(407.5,DDA,0)),U)

 +4                IF $GET(LETE)=""

                       QUIT 

 +5                SET DLPE=$$FMTE^XLFDT($PIECE($GET(LET(DDA)),U))

 +6                SET NT=$PIECE($GET(LET(DDA)),U,2)

 +7                WRITE !,LETE,?30,DLPE,?60,NT

               End DoDot:1

 +8        QUIT 

 +9       ;

HDR(P)    ;-- Get the header

 +1        WRITE !,"Patient Letter Tracking for: "_$PIECE($GET(^DPT(P,0)),U),?55,"Date Printed: "_DT

 +2        WRITE !!,"Letter",?30,"Last Date Printed",?60,"Number of times",!

 +3        FOR I=1:1:80

               WRITE "-"

 +4        QUIT 

 +5       ;

XIT       ;-- exit and quit

 +1        DO ^%ZISC

 +2        KILL LET

 +3        QUIT 

 +4       ;