PSUSUM1 ;BIR/DAM - Summary Report for Provider Extract ; 2/23/07 2:18pm
;;4.0;PHARMACY BENEFITS MANAGEMENT;**12**;MARCH, 2005;Build 19
;
; No DBIA's required.
;
EN ;EN CALLED FROM ^PSUDEM4
;
D PULL^PSUCP
D DATE
D PRSUM^PSUDEM5 ;Mail message
Q
;
DATE ;Convert dates to external format
;
S %H=$E($H,1,5) ;today's date
D YX^%DTC
N PSUD S PSUD=Y
;
S Y=PSUSDT ;Start date of extract
D DD^%DT
N PSUS S PSUS=Y
;
S Y=PSUEDT ;End date of extract
D DD^%DT
N PSUE S PSUE=Y
;
D SUMM
Q
;
SUMM ;Compose summary mail message by placing all text into a
;temporary global, designated ^XTMP("PSU_"_PSUJOB,"PSUSUM",
;
;
;Report header
I '$D(^XTMP("PSU_"_PSUJOB,"PSUPROV")) D Q
.S ^XTMP("PSU_"_PSUJOB,"PSUSUM",1)="No data to report"
S ^XTMP("PSU_"_PSUJOB,"PSUSUM",1)="Provider Summary Report "_PSUD
S ^XTMP("PSU_"_PSUJOB,"PSUSUM",2)="" ;Blank line
S ^XTMP("PSU_"_PSUJOB,"PSUSUM",3)=" "_PSUS_" through "_PSUE
S ^XTMP("PSU_"_PSUJOB,"PSUSUM",4)=""
S $P(^XTMP("PSU_"_PSUJOB,"PSUSUM",5),"-",80)="" ;Separator Bar
S $P(^XTMP("PSU_"_PSUJOB,"PSUSUM",7),"-",80)=""
S ^XTMP("PSU_"_PSUJOB,"PSUSUM",8)=""
S ^XTMP("PSU_"_PSUJOB,"PSUSUM",9)="IEN Provider Name (SSN) Missing Data"
S $P(^XTMP("PSU_"_PSUJOB,"PSUSUM",10),"-",80)=""
D PROV
;
Q
;
PROV ;Gather missing provider data for summary report
;
N PSUSSN3,PSUMIS,PSUCL,PSUSS,PSUSP,PSUSUB,PSULN,PSUM
S PSUM=0
S PSULN=11
S PSUIP=0
F S PSUIP=$O(^XTMP("PSU_"_PSUJOB,"PSUPROV",PSUIP)) Q:PSUIP="" Q:PSUIP["U" D
.I $P($G(^VA(200,PSUIP,"PS")),"^",6)=4 Q ; Exclude if the provider type is "FEE BASIS" (PSU*4*12)
.S PSUSSN3=$E($P($G(^XTMP("PSU_"_PSUJOB,"PSUPROV",PSUIP)),U,3),6,9)
.I PSUSSN3="" S PSUSSN3="????",PSUMIS="SSN" D NAM ;No SSN
.S PSUCL=$P($G(^XTMP("PSU_"_PSUJOB,"PSUPROV",PSUIP)),U,5)
.I PSUCL="" S PSUMIS="PROVIDER CLASS" D NAM ;No Class
.S PSUSS=$P($G(^XTMP("PSU_"_PSUJOB,"PSUPROV",PSUIP)),U,6)
.I PSUSS="" S PSUMIS="SERVICE/SECTION" D NAM ;No Ser/Sec
.S PSUSP=$P($G(^XTMP("PSU_"_PSUJOB,"PSUPROV",PSUIP)),U,7)
.I PSUSP="" S PSUMIS="SPECIALTY" D NAM ;No Spec
.Q:PSUSP["Intern" ;Omit interns from missing subspec. on report
.Q:PSUSP["Resident" ;Omit residents from missing subspc. on report
.S PSUSUB=$P($G(^XTMP("PSU_"_PSUJOB,"PSUPROV",PSUIP)),U,8)
.I PSUSUB="" S PSUMIS="SUBSPECIALTY" D NAM ;No Subsp
Q
;
NAM ;Get Provider name and create entry line in summary report
;
N PSUNAM,PSUT1,PSUT2,PSUT3,PSUT4,S1,S2,S3
N PSUT5,PSUT6,PSUT7,PSUT8,PSUT9,PSUT10
;
S PSUT4=" "
S PSUT1=11
S PSUT2=PSUT1-$L(PSUIP)
F S1=1:1:(PSUT2-1) S PSUT3(S1)=" " D
.S PSUT4=PSUT4_PSUT3(S1) ;First tab position
;
S PSUNAM=$P($G(^XTMP("PSU_"_PSUJOB,"PSUPROV",PSUIP)),U,9)
;
S PSUT5=" "
S PSUT6=54
S PSUT7=(PSUT6-$L(PSUNAM)-7-$L(PSUT4)-$L(PSUIP))
F S2=1:1:(PSUT7-1) S PSUT8(S2)=" " D
.S PSUT5=PSUT5_PSUT8(S2) ;Second tab position
;
S PSUT10=" "
F S3=1:1:(PSUT6-1) S PSUT9(S3)=" " D
.S PSUT10=PSUT10_PSUT9(S3) ;Third tab position
;
;
;I '$D(^XTMP("PSU_"_PSUJOB,"PSUSUM",PSULN)) D
S ^XTMP("PSU_"_PSUJOB,"PSUSUM",PSULN)=PSUIP_PSUT4_PSUNAM_" ("_PSUSSN3_")"_PSUT5_PSUMIS
F I=1:1:5 I $P($G(^XTMP("PSU_"_PSUJOB,"PSUSUM",PSULN-I)),U,1)[PSUNAM D
.S ^XTMP("PSU_"_PSUJOB,"PSUSUM",PSULN)=PSUT10_PSUMIS
;
I $P($G(^XTMP("PSU_"_PSUJOB,"PSUSUM",PSULN)),U,1)[PSUNAM D
.S PSUM=PSUM+1 ;Set a counter for number of patients accessed
.S ^XTMP("PSU_"_PSUJOB,"PSUSUM",6)="Total Number of Incomplete Provider Records Extracted: "_PSUM
S PSULN=PSULN+1
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUSUM1 3743 printed Apr 09, 2024@21:29:50 Page 2
PSUSUM1 ;BIR/DAM - Summary Report for Provider Extract ; 2/23/07 2:18pm
+1 ;;4.0;PHARMACY BENEFITS MANAGEMENT;**12**;MARCH, 2005;Build 19
+2 ;
+3 ; No DBIA's required.
+4 ;
EN ;EN CALLED FROM ^PSUDEM4
+1 ;
+2 DO PULL^PSUCP
+3 DO DATE
+4 ;Mail message
DO PRSUM^PSUDEM5
+5 QUIT
+6 ;
DATE ;Convert dates to external format
+1 ;
+2 ;today's date
SET %H=$EXTRACT($HOROLOG,1,5)
+3 DO YX^%DTC
+4 NEW PSUD
SET PSUD=Y
+5 ;
+6 ;Start date of extract
SET Y=PSUSDT
+7 DO DD^%DT
+8 NEW PSUS
SET PSUS=Y
+9 ;
+10 ;End date of extract
SET Y=PSUEDT
+11 DO DD^%DT
+12 NEW PSUE
SET PSUE=Y
+13 ;
+14 DO SUMM
+15 QUIT
+16 ;
SUMM ;Compose summary mail message by placing all text into a
+1 ;temporary global, designated ^XTMP("PSU_"_PSUJOB,"PSUSUM",
+2 ;
+3 ;
+4 ;Report header
+5 IF '$DATA(^XTMP("PSU_"_PSUJOB,"PSUPROV"))
Begin DoDot:1
+6 SET ^XTMP("PSU_"_PSUJOB,"PSUSUM",1)="No data to report"
End DoDot:1
QUIT
+7 SET ^XTMP("PSU_"_PSUJOB,"PSUSUM",1)="Provider Summary Report "_PSUD
+8 ;Blank line
SET ^XTMP("PSU_"_PSUJOB,"PSUSUM",2)=""
+9 SET ^XTMP("PSU_"_PSUJOB,"PSUSUM",3)=" "_PSUS_" through "_PSUE
+10 SET ^XTMP("PSU_"_PSUJOB,"PSUSUM",4)=""
+11 ;Separator Bar
SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUSUM",5),"-",80)=""
+12 SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUSUM",7),"-",80)=""
+13 SET ^XTMP("PSU_"_PSUJOB,"PSUSUM",8)=""
+14 SET ^XTMP("PSU_"_PSUJOB,"PSUSUM",9)="IEN Provider Name (SSN) Missing Data"
+15 SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUSUM",10),"-",80)=""
+16 DO PROV
+17 ;
+18 QUIT
+19 ;
PROV ;Gather missing provider data for summary report
+1 ;
+2 NEW PSUSSN3,PSUMIS,PSUCL,PSUSS,PSUSP,PSUSUB,PSULN,PSUM
+3 SET PSUM=0
+4 SET PSULN=11
+5 SET PSUIP=0
+6 FOR
SET PSUIP=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUPROV",PSUIP))
if PSUIP=""
QUIT
if PSUIP["U"
QUIT
Begin DoDot:1
+7 ; Exclude if the provider type is "FEE BASIS" (PSU*4*12)
IF $PIECE($GET(^VA(200,PSUIP,"PS")),"^",6)=4
QUIT
+8 SET PSUSSN3=$EXTRACT($PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUPROV",PSUIP)),U,3),6,9)
+9 ;No SSN
IF PSUSSN3=""
SET PSUSSN3="????"
SET PSUMIS="SSN"
DO NAM
+10 SET PSUCL=$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUPROV",PSUIP)),U,5)
+11 ;No Class
IF PSUCL=""
SET PSUMIS="PROVIDER CLASS"
DO NAM
+12 SET PSUSS=$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUPROV",PSUIP)),U,6)
+13 ;No Ser/Sec
IF PSUSS=""
SET PSUMIS="SERVICE/SECTION"
DO NAM
+14 SET PSUSP=$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUPROV",PSUIP)),U,7)
+15 ;No Spec
IF PSUSP=""
SET PSUMIS="SPECIALTY"
DO NAM
+16 ;Omit interns from missing subspec. on report
if PSUSP["Intern"
QUIT
+17 ;Omit residents from missing subspc. on report
if PSUSP["Resident"
QUIT
+18 SET PSUSUB=$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUPROV",PSUIP)),U,8)
+19 ;No Subsp
IF PSUSUB=""
SET PSUMIS="SUBSPECIALTY"
DO NAM
End DoDot:1
+20 QUIT
+21 ;
NAM ;Get Provider name and create entry line in summary report
+1 ;
+2 NEW PSUNAM,PSUT1,PSUT2,PSUT3,PSUT4,S1,S2,S3
+3 NEW PSUT5,PSUT6,PSUT7,PSUT8,PSUT9,PSUT10
+4 ;
+5 SET PSUT4=" "
+6 SET PSUT1=11
+7 SET PSUT2=PSUT1-$LENGTH(PSUIP)
+8 FOR S1=1:1:(PSUT2-1)
SET PSUT3(S1)=" "
Begin DoDot:1
+9 ;First tab position
SET PSUT4=PSUT4_PSUT3(S1)
End DoDot:1
+10 ;
+11 SET PSUNAM=$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUPROV",PSUIP)),U,9)
+12 ;
+13 SET PSUT5=" "
+14 SET PSUT6=54
+15 SET PSUT7=(PSUT6-$LENGTH(PSUNAM)-7-$LENGTH(PSUT4)-$LENGTH(PSUIP))
+16 FOR S2=1:1:(PSUT7-1)
SET PSUT8(S2)=" "
Begin DoDot:1
+17 ;Second tab position
SET PSUT5=PSUT5_PSUT8(S2)
End DoDot:1
+18 ;
+19 SET PSUT10=" "
+20 FOR S3=1:1:(PSUT6-1)
SET PSUT9(S3)=" "
Begin DoDot:1
+21 ;Third tab position
SET PSUT10=PSUT10_PSUT9(S3)
End DoDot:1
+22 ;
+23 ;
+24 ;I '$D(^XTMP("PSU_"_PSUJOB,"PSUSUM",PSULN)) D
+25 SET ^XTMP("PSU_"_PSUJOB,"PSUSUM",PSULN)=PSUIP_PSUT4_PSUNAM_" ("_PSUSSN3_")"_PSUT5_PSUMIS
+26 FOR I=1:1:5
IF $PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUSUM",PSULN-I)),U,1)[PSUNAM
Begin DoDot:1
+27 SET ^XTMP("PSU_"_PSUJOB,"PSUSUM",PSULN)=PSUT10_PSUMIS
End DoDot:1
+28 ;
+29 IF $PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUSUM",PSULN)),U,1)[PSUNAM
Begin DoDot:1
+30 ;Set a counter for number of patients accessed
SET PSUM=PSUM+1
+31 SET ^XTMP("PSU_"_PSUJOB,"PSUSUM",6)="Total Number of Incomplete Provider Records Extracted: "_PSUM
End DoDot:1
+32 SET PSULN=PSULN+1
+33 ;
+34 QUIT
