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 Oct 16, 2024@18:28:25 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
