SCDXPRN1.m

SCDXPRN1 ;ALB/JRP - HISTORY FILE REPORTS;21-JUL-1997

 ;;5.3;Scheduling;**128,140**;AUG 13, 1993

 ;

PATHIST ;Print transmission history report for patient

 ; - Report based within the ACRP Transmission History file (#409.77)

 ; - User prompted for patient and encounter date range

 ; - Report formatted for 80 columns (allows output to screen)

 ;

 ;Declare variables

 N DFN,BEGDATE,ENDDATE

 N DIC,L,FLDS,BY,FR,TO,DISPAR,DHD,X,Y,DTOUT,DUOUT

 ;Get patient

 W !!!,">> PATIENT SELECTION <<",!

 S DIC=2

 S DIC(0)="AEMQZ"

 D ^DIC

 Q:(($D(DTOUT))!($D(DUOUT))!(Y<0))

 S DFN=+Y

 ;Get date range

 W !!!,">> DATE RANGE SELECTION <<",!

 ; Earliest and latest date allowed

 S BEGDATE=2961001

 S ENDDATE=$$DT^XLFDT()

 ; Begin date help text

 S FR(1)="Enter encounter date to begin search from"

 S FR(2)=" "

 S FR(3)=$$FMTE^XLFDT(BEGDATE)_" is the earliest date allowed"

 S FR(4)=$$FMTE^XLFDT(ENDDATE)_" will be the latest date allowed"

 S FR(5)=" "

 S FR(6)="Note: Encounter date does not always match date of"

 S FR="      transmission to the National Patient Care Database"

 ; End date help text

 S TO(1)="Enter encounter date to end search at"

 S TO(2)=" "

 S TO(3)=$$FMTE^XLFDT(ENDDATE)_" is the latest date allowed"

 S TO(4)=$$FMTE^XLFDT(BEGDATE)_" was the earliest date allowed"

 S TO(5)=" "

 S TO(6)="Note: Encounter date does not always match date of"

 S TO="      transmission to the National Patient Care Database"

 S L=$$GETDTRNG^SCDXUTL1(BEGDATE,ENDDATE,"FR","TO")

 Q:(L<0)

 S BEGDATE=+$P(L,"^",1)

 S ENDDATE=+$P(L,"^",2)

 K FR,TO

 ;Make end date midnight

 S ENDDATE=$$FMADD^XLFDT(ENDDATE,0,23,59,59)

 ;Define sort criteria

 S DIC="^SD(409.77,"

 S L=0

 S BY="+.06;S"

 S FR=""

 S TO=""

 ;Pre-sort accomplished through ADFN x-ref

 S BY(0)="^SD(409.77,""ADFN"","

 S L(0)=3

 S FR(0,1)=DFN

 S TO(0,1)=DFN

 S FR(0,2)=BEGDATE

 S TO(0,2)=ENDDATE

 ;Define subheader

 S DISPAR(0,1)="^;""PATIENT: """

 S DISPAR(0,1,"OUT")="N DFN,VA,VAERR S DFN=Y D PID^VADPT S Y=$P($G(^DPT(DFN,0),""BAD DFN""),""^"",1)_""  (""_$S(VAERR:(""#""_DFN),1:VA(""BID""))_"")"""

 ;Define print fields

 S FLDS="[SCDX XMIT HIST FOR PATIENT]"

 ;Define header

 S DHD="ACRP TRANSMISSIONS FOR ENCOUNTERS OCCURRING BETWEEN "_$$FMTE^XLFDT(BEGDATE,"5D")_" AND "_$$FMTE^XLFDT(ENDDATE,"5D")

 ;Print report

 D EN1^DIP

 ;Done

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SCDXPRN1   2346     printed  Apr 23, 2025@18:53:58                                                                                                                                                                                                    Page 2

SCDXPRN1  ;ALB/JRP - HISTORY FILE REPORTS;21-JUL-1997

 +1       ;;5.3;Scheduling;**128,140**;AUG 13, 1993

 +2       ;

PATHIST   ;Print transmission history report for patient

 +1       ; - Report based within the ACRP Transmission History file (#409.77)

 +2       ; - User prompted for patient and encounter date range

 +3       ; - Report formatted for 80 columns (allows output to screen)

 +4       ;

 +5       ;Declare variables

 +6        NEW DFN,BEGDATE,ENDDATE

 +7        NEW DIC,L,FLDS,BY,FR,TO,DISPAR,DHD,X,Y,DTOUT,DUOUT

 +8       ;Get patient

 +9        WRITE !!!,">> PATIENT SELECTION <<",!

 +10       SET DIC=2

 +11       SET DIC(0)="AEMQZ"

 +12       DO ^DIC

 +13       if (($DATA(DTOUT))!($DATA(DUOUT))!(Y<0))

               QUIT 

 +14       SET DFN=+Y

 +15      ;Get date range

 +16       WRITE !!!,">> DATE RANGE SELECTION <<",!

 +17      ; Earliest and latest date allowed

 +18       SET BEGDATE=2961001

 +19       SET ENDDATE=$$DT^XLFDT()

 +20      ; Begin date help text

 +21       SET FR(1)="Enter encounter date to begin search from"

 +22       SET FR(2)=" "

 +23       SET FR(3)=$$FMTE^XLFDT(BEGDATE)_" is the earliest date allowed"

 +24       SET FR(4)=$$FMTE^XLFDT(ENDDATE)_" will be the latest date allowed"

 +25       SET FR(5)=" "

 +26       SET FR(6)="Note: Encounter date does not always match date of"

 +27       SET FR="      transmission to the National Patient Care Database"

 +28      ; End date help text

 +29       SET TO(1)="Enter encounter date to end search at"

 +30       SET TO(2)=" "

 +31       SET TO(3)=$$FMTE^XLFDT(ENDDATE)_" is the latest date allowed"

 +32       SET TO(4)=$$FMTE^XLFDT(BEGDATE)_" was the earliest date allowed"

 +33       SET TO(5)=" "

 +34       SET TO(6)="Note: Encounter date does not always match date of"

 +35       SET TO="      transmission to the National Patient Care Database"

 +36       SET L=$$GETDTRNG^SCDXUTL1(BEGDATE,ENDDATE,"FR","TO")

 +37       if (L<0)

               QUIT 

 +38       SET BEGDATE=+$PIECE(L,"^",1)

 +39       SET ENDDATE=+$PIECE(L,"^",2)

 +40       KILL FR,TO

 +41      ;Make end date midnight

 +42       SET ENDDATE=$$FMADD^XLFDT(ENDDATE,0,23,59,59)

 +43      ;Define sort criteria

 +44       SET DIC="^SD(409.77,"

 +45       SET L=0

 +46       SET BY="+.06;S"

 +47       SET FR=""

 +48       SET TO=""

 +49      ;Pre-sort accomplished through ADFN x-ref

 +50       SET BY(0)="^SD(409.77,""ADFN"","

 +51       SET L(0)=3

 +52       SET FR(0,1)=DFN

 +53       SET TO(0,1)=DFN

 +54       SET FR(0,2)=BEGDATE

 +55       SET TO(0,2)=ENDDATE

 +56      ;Define subheader

 +57       SET DISPAR(0,1)="^;""PATIENT: """

 +58       SET DISPAR(0,1,"OUT")="N DFN,VA,VAERR S DFN=Y D PID^VADPT S Y=$P($G(^DPT(DFN,0),""BAD DFN""),""^"",1)_""  (""_$S(VAERR:(""#""_DFN),1:VA(""BID""))_"")"""

 +59      ;Define print fields

 +60       SET FLDS="[SCDX XMIT HIST FOR PATIENT]"

 +61      ;Define header

 +62       SET DHD="ACRP TRANSMISSIONS FOR ENCOUNTERS OCCURRING BETWEEN "_$$FMTE^XLFDT(BEGDATE,"5D")_" AND "_$$FMTE^XLFDT(ENDDATE,"5D")

 +63      ;Print report

 +64       DO EN1^DIP

 +65      ;Done

 +66       QUIT