- PSUDEM0 ;BIR/DAM - Patient Demographics Summary Print Routine ; 20 DEC 2001
- ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
- ;
- ;
- PRINT ;Print header for pt demographics
- Q
- ;
- OPV ;EN Outpatient Visit "No Data" message. Called only when
- ; user answers 'yes'
- ;to "Do you want to receive this in a MailMan message?" AND when there
- ;is no data to report.
- ;
- Q:$D(^XTMP("PSU_"_PSUJOB,"PSUFLAG3"))
- Q:PSUSMRY ;Don't print if user wants summary only
- Q:$D(^XTMP("PSU_"_PSUJOB,"PSUOPV"))
- ;
- W @IOF
- D DT^DILF("E",PSUSDT,.EXTD)
- S PSURP("START")=EXTD(0)
- D DT^DILF("E",PSUEDT,.EXTD)
- S PSURP("END")=EXTD(0)
- ;
- S PSUOVSUB="PSUOPV_"_PSUJOB
- S ^XTMP(PSUOVSUB,"PSUOPV",PSUSNDR,1)="Outpatient Visits for "_PSURP("START")_" through "_PSURP("END")
- S ^XTMP(PSUOVSUB,"PSUOPV",PSUSNDR,2)=" "
- S ^XTMP(PSUOVSUB,"PSUOPV",PSUSNDR,3)="No data to report"
- ;
- U IO
- ;
- ;F I=1:1:3 W !
- S PSUL=0
- F S PSUL=$O(^XTMP(PSUOVSUB,"PSUOPV",PSUSNDR,PSUL)) Q:PSUL="" D
- .S X=^XTMP(PSUOVSUB,"PSUOPV",PSUSNDR,PSUL) W !,X
- .I PSUL=1 W " for ",$P(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,2),!,?72,"PAGE: 1"
- ;
- Q
- ;
- PTF ;EN Inpatient Visit "No Data" message.
- ;Called only when user answers 'YES'
- ;to "Do you want to receive this in a MailMan message?" AND when there
- ;is no data to report.
- ;
- Q:$D(^XTMP("PSU_"_PSUJOB,"PSUFLAG3"))
- Q:PSUSMRY ;Don't print if user wants summary only
- Q:$D(^XTMP("PSU_"_PSUJOB,"PSUIPV"))
- ;
- W @IOF
- D DT^DILF("E",PSUSDT,.EXTD)
- S PSURP("START")=EXTD(0)
- D DT^DILF("E",PSUEDT,.EXTD)
- S PSURP("END")=EXTD(0)
- ;
- S PSUIVSUB="PSUIPV_"_PSUJOB
- S ^XTMP(PSUIVSUB,"PSUIPV",PSUSNDR,1)="Inpatient PTF Records for "_PSURP("START")_" through "_PSURP("END")
- S ^XTMP(PSUIVSUB,"PSUIPV",PSUSNDR,2)=" "
- S ^XTMP(PSUIVSUB,"PSUIPV",PSUSNDR,3)="No data to report"
- ;
- U IO
- ;
- ;F I=1:1:3 W !
- S PSUL=0
- F S PSUL=$O(^XTMP(PSUIVSUB,"PSUIPV",PSUSNDR,PSUL)) Q:PSUL="" D
- .S X=^XTMP(PSUIVSUB,"PSUIPV",PSUSNDR,PSUL) W !,X
- .I PSUL=1 W " for ",$P(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,2),!,?72,"PAGE: 1"
- ;
- Q
- ;
- PRO ;EN Provider information print routine. Prints summary report.
- ;Called only when user answers 'NO'
- ;to "Do you want to receive this in a MailMan message?"
- ;
- D DT^DILF("E",PSUSDT,.EXTD)
- S PSURP("START")=EXTD(0)
- D DT^DILF("E",PSUEDT,.EXTD)
- S PSURP("END")=EXTD(0)
- ;
- S PSUPGS("PG")=1
- ;
- S PSUPROSB="PSUPRO_"_PSUJOB
- D PGHDR
- ;
- S N=0,K=3
- F S N=$O(^XTMP("PSU_"_PSUJOB,"PSUSUM",N)) Q:N="" D
- .M ^XTMP(PSUPROSB,"PSUPRO",PSUSNDR,K)=^XTMP("PSU_"_PSUJOB,"PSUSUM",N)
- .S K=K+1 ;Set Provider summary into XTMP global
- ;
- ;
- S PSUL=0
- F S PSUL=$O(^XTMP(PSUPROSB,"PSUPRO",PSUSNDR,PSUL)) Q:PSUL="" D
- .I LNCNT+4>IOSL D PGHDR
- .S X=^XTMP(PSUPROSB,"PSUPRO",PSUSNDR,PSUL) W !,X
- .S LNCNT=LNCNT+1
- ;
- K ^XTMP("PSU_"_PSUJOB,"PSUSUM")
- Q
- ;
- PGHDR ;Page header for Provider summary message
- ;VMP-IOFO BAY PINES;ELR;PSU*3.0*26 REMOVE FORM FEED
- ;U IO W @IOF
- W "Provider Data for "_PSURP("START")_" through "_PSURP("END")_" for "_$P(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,2)
- W !,?68,"PAGE: "_PSUPGS("PG")
- S PSUPGS("PG")=PSUPGS("PG")+1
- F PSUH=9:1:12 W !,$G(^XTMP(PSUPROSB,"PSUPRO",PSUSNDR,PSUH))
- S LNCNT=5
- Q
- ;
- IVSUM ;EN Print routine for all Pt. Demographics Summary reports.
- ;Prints NO Data
- ;and Summary report to screen if user answers 'N' to "Do you want a
- ;copy of this message sent to you in mailman?"
- ;
- D INST^PSUDEM1
- D COMM
- U IO
- W @IOF
- ;
- S PSUIVSUB="PSUPD_"_PSUJOB
- S ^XTMP(PSUIVSUB,"PSUPD",PSUSNDR,1)="Patient Demographics Summary for "_PSURP("START")_" through "_PSURP("END")
- S ^XTMP(PSUIVSUB,"PSUPD",PSUSNDR,2)=" "
- ;
- ;Do the following if there is no data to report
- I $D(^XTMP("PSU_"_PSUJOB,"PSUNONE")) D Q
- .S ^XTMP(PSUIVSUB,"PSUPD",PSUSNDR,3)="No data to report"
- .S PSUL=0
- .F S PSUL=$O(^XTMP(PSUIVSUB,"PSUPD",PSUSNDR,PSUL)) Q:PSUL="" D
- ..S X=^XTMP(PSUIVSUB,"PSUPD",PSUSNDR,PSUL) W !,X
- ..I PSUL=2 W " for ",$P(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,2),!,?69,"Page: 1"
- ;
- ;Do the following if there is data to report in a summary
- S N=0,K=3
- F S N=$O(^XTMP("PSU_"_PSUJOB,"PSUSUMA",N)) Q:N="" D
- .M ^XTMP(PSUIVSUB,"PSUPD",PSUSNDR,K)=^XTMP("PSU_"_PSUJOB,"PSUSUMA",N)
- .S K=K+1 ;Set Provider summary into XTMP global
- ;
- ;
- S PSUL=0
- F S PSUL=$O(^XTMP(PSUIVSUB,"PSUPD",PSUSNDR,PSUL)) Q:PSUL="" D
- .S X=^XTMP(PSUIVSUB,"PSUPD",PSUSNDR,PSUL) W !,X
- .I PSUL=2 W " for ",$P(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,2),!,?69,"Page: 1"
- ;
- Q
- ;
- COMM ;Common variables among all print subroutines
- ;
- D DT^DILF("E",PSUSDT,.EXTD)
- S PSURP("START")=EXTD(0)
- D DT^DILF("E",PSUEDT,.EXTD)
- S PSURP("END")=EXTD(0)
- ;
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUDEM0 4707 printed Jan 18, 2025@03:28:24 Page 2
- PSUDEM0 ;BIR/DAM - Patient Demographics Summary Print Routine ; 20 DEC 2001
- +1 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
- +2 ;
- +3 ;
- PRINT ;Print header for pt demographics
- +1 QUIT
- +2 ;
- OPV ;EN Outpatient Visit "No Data" message. Called only when
- +1 ; user answers 'yes'
- +2 ;to "Do you want to receive this in a MailMan message?" AND when there
- +3 ;is no data to report.
- +4 ;
- +5 if $DATA(^XTMP("PSU_"_PSUJOB,"PSUFLAG3"))
- QUIT
- +6 ;Don't print if user wants summary only
- if PSUSMRY
- QUIT
- +7 if $DATA(^XTMP("PSU_"_PSUJOB,"PSUOPV"))
- QUIT
- +8 ;
- +9 WRITE @IOF
- +10 DO DT^DILF("E",PSUSDT,.EXTD)
- +11 SET PSURP("START")=EXTD(0)
- +12 DO DT^DILF("E",PSUEDT,.EXTD)
- +13 SET PSURP("END")=EXTD(0)
- +14 ;
- +15 SET PSUOVSUB="PSUOPV_"_PSUJOB
- +16 SET ^XTMP(PSUOVSUB,"PSUOPV",PSUSNDR,1)="Outpatient Visits for "_PSURP("START")_" through "_PSURP("END")
- +17 SET ^XTMP(PSUOVSUB,"PSUOPV",PSUSNDR,2)=" "
- +18 SET ^XTMP(PSUOVSUB,"PSUOPV",PSUSNDR,3)="No data to report"
- +19 ;
- +20 USE IO
- +21 ;
- +22 ;F I=1:1:3 W !
- +23 SET PSUL=0
- +24 FOR
- SET PSUL=$ORDER(^XTMP(PSUOVSUB,"PSUOPV",PSUSNDR,PSUL))
- if PSUL=""
- QUIT
- Begin DoDot:1
- +25 SET X=^XTMP(PSUOVSUB,"PSUOPV",PSUSNDR,PSUL)
- WRITE !,X
- +26 IF PSUL=1
- WRITE " for ",$PIECE(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,2),!,?72,"PAGE: 1"
- End DoDot:1
- +27 ;
- +28 QUIT
- +29 ;
- PTF ;EN Inpatient Visit "No Data" message.
- +1 ;Called only when user answers 'YES'
- +2 ;to "Do you want to receive this in a MailMan message?" AND when there
- +3 ;is no data to report.
- +4 ;
- +5 if $DATA(^XTMP("PSU_"_PSUJOB,"PSUFLAG3"))
- QUIT
- +6 ;Don't print if user wants summary only
- if PSUSMRY
- QUIT
- +7 if $DATA(^XTMP("PSU_"_PSUJOB,"PSUIPV"))
- QUIT
- +8 ;
- +9 WRITE @IOF
- +10 DO DT^DILF("E",PSUSDT,.EXTD)
- +11 SET PSURP("START")=EXTD(0)
- +12 DO DT^DILF("E",PSUEDT,.EXTD)
- +13 SET PSURP("END")=EXTD(0)
- +14 ;
- +15 SET PSUIVSUB="PSUIPV_"_PSUJOB
- +16 SET ^XTMP(PSUIVSUB,"PSUIPV",PSUSNDR,1)="Inpatient PTF Records for "_PSURP("START")_" through "_PSURP("END")
- +17 SET ^XTMP(PSUIVSUB,"PSUIPV",PSUSNDR,2)=" "
- +18 SET ^XTMP(PSUIVSUB,"PSUIPV",PSUSNDR,3)="No data to report"
- +19 ;
- +20 USE IO
- +21 ;
- +22 ;F I=1:1:3 W !
- +23 SET PSUL=0
- +24 FOR
- SET PSUL=$ORDER(^XTMP(PSUIVSUB,"PSUIPV",PSUSNDR,PSUL))
- if PSUL=""
- QUIT
- Begin DoDot:1
- +25 SET X=^XTMP(PSUIVSUB,"PSUIPV",PSUSNDR,PSUL)
- WRITE !,X
- +26 IF PSUL=1
- WRITE " for ",$PIECE(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,2),!,?72,"PAGE: 1"
- End DoDot:1
- +27 ;
- +28 QUIT
- +29 ;
- PRO ;EN Provider information print routine. Prints summary report.
- +1 ;Called only when user answers 'NO'
- +2 ;to "Do you want to receive this in a MailMan message?"
- +3 ;
- +4 DO DT^DILF("E",PSUSDT,.EXTD)
- +5 SET PSURP("START")=EXTD(0)
- +6 DO DT^DILF("E",PSUEDT,.EXTD)
- +7 SET PSURP("END")=EXTD(0)
- +8 ;
- +9 SET PSUPGS("PG")=1
- +10 ;
- +11 SET PSUPROSB="PSUPRO_"_PSUJOB
- +12 DO PGHDR
- +13 ;
- +14 SET N=0
- SET K=3
- +15 FOR
- SET N=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUSUM",N))
- if N=""
- QUIT
- Begin DoDot:1
- +16 MERGE ^XTMP(PSUPROSB,"PSUPRO",PSUSNDR,K)=^XTMP("PSU_"_PSUJOB,"PSUSUM",N)
- +17 ;Set Provider summary into XTMP global
- SET K=K+1
- End DoDot:1
- +18 ;
- +19 ;
- +20 SET PSUL=0
- +21 FOR
- SET PSUL=$ORDER(^XTMP(PSUPROSB,"PSUPRO",PSUSNDR,PSUL))
- if PSUL=""
- QUIT
- Begin DoDot:1
- +22 IF LNCNT+4>IOSL
- DO PGHDR
- +23 SET X=^XTMP(PSUPROSB,"PSUPRO",PSUSNDR,PSUL)
- WRITE !,X
- +24 SET LNCNT=LNCNT+1
- End DoDot:1
- +25 ;
- +26 KILL ^XTMP("PSU_"_PSUJOB,"PSUSUM")
- +27 QUIT
- +28 ;
- PGHDR ;Page header for Provider summary message
- +1 ;VMP-IOFO BAY PINES;ELR;PSU*3.0*26 REMOVE FORM FEED
- +2 ;U IO W @IOF
- +3 WRITE "Provider Data for "_PSURP("START")_" through "_PSURP("END")_" for "_$PIECE(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,2)
- +4 WRITE !,?68,"PAGE: "_PSUPGS("PG")
- +5 SET PSUPGS("PG")=PSUPGS("PG")+1
- +6 FOR PSUH=9:1:12
- WRITE !,$GET(^XTMP(PSUPROSB,"PSUPRO",PSUSNDR,PSUH))
- +7 SET LNCNT=5
- +8 QUIT
- +9 ;
- IVSUM ;EN Print routine for all Pt. Demographics Summary reports.
- +1 ;Prints NO Data
- +2 ;and Summary report to screen if user answers 'N' to "Do you want a
- +3 ;copy of this message sent to you in mailman?"
- +4 ;
- +5 DO INST^PSUDEM1
- +6 DO COMM
- +7 USE IO
- +8 WRITE @IOF
- +9 ;
- +10 SET PSUIVSUB="PSUPD_"_PSUJOB
- +11 SET ^XTMP(PSUIVSUB,"PSUPD",PSUSNDR,1)="Patient Demographics Summary for "_PSURP("START")_" through "_PSURP("END")
- +12 SET ^XTMP(PSUIVSUB,"PSUPD",PSUSNDR,2)=" "
- +13 ;
- +14 ;Do the following if there is no data to report
- +15 IF $DATA(^XTMP("PSU_"_PSUJOB,"PSUNONE"))
- Begin DoDot:1
- +16 SET ^XTMP(PSUIVSUB,"PSUPD",PSUSNDR,3)="No data to report"
- +17 SET PSUL=0
- +18 FOR
- SET PSUL=$ORDER(^XTMP(PSUIVSUB,"PSUPD",PSUSNDR,PSUL))
- if PSUL=""
- QUIT
- Begin DoDot:2
- +19 SET X=^XTMP(PSUIVSUB,"PSUPD",PSUSNDR,PSUL)
- WRITE !,X
- +20 IF PSUL=2
- WRITE " for ",$PIECE(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,2),!,?69,"Page: 1"
- End DoDot:2
- End DoDot:1
- QUIT
- +21 ;
- +22 ;Do the following if there is data to report in a summary
- +23 SET N=0
- SET K=3
- +24 FOR
- SET N=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUSUMA",N))
- if N=""
- QUIT
- Begin DoDot:1
- +25 MERGE ^XTMP(PSUIVSUB,"PSUPD",PSUSNDR,K)=^XTMP("PSU_"_PSUJOB,"PSUSUMA",N)
- +26 ;Set Provider summary into XTMP global
- SET K=K+1
- End DoDot:1
- +27 ;
- +28 ;
- +29 SET PSUL=0
- +30 FOR
- SET PSUL=$ORDER(^XTMP(PSUIVSUB,"PSUPD",PSUSNDR,PSUL))
- if PSUL=""
- QUIT
- Begin DoDot:1
- +31 SET X=^XTMP(PSUIVSUB,"PSUPD",PSUSNDR,PSUL)
- WRITE !,X
- +32 IF PSUL=2
- WRITE " for ",$PIECE(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,2),!,?69,"Page: 1"
- End DoDot:1
- +33 ;
- +34 QUIT
- +35 ;
- COMM ;Common variables among all print subroutines
- +1 ;
- +2 DO DT^DILF("E",PSUSDT,.EXTD)
- +3 SET PSURP("START")=EXTD(0)
- +4 DO DT^DILF("E",PSUEDT,.EXTD)
- +5 SET PSURP("END")=EXTD(0)
- +6 ;
- +7 QUIT