PSUUD7 ;BIR/DAM - UD AMIS Summary Message II;23 MAR 2004
;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
;
;Reference to file #40.8 supported by DBIA 2438
;
EN ;Entry point for MailMan message
;Called from PSUUD0
;
K AMIS,DOSE,DOSTOT,SPEC,DIVTOT,GTOT ;Kill arrays to hold data
;
D MSG
F PSULN=PSULN:1:(PSULN+3) S AMIS(PSULN)="" ;Blank lines
M ^XTMP("PSU_"_PSUJOB,"UDAMIS")=AMIS
D MAIL
;
Q
;
MSG ;Set up lines in message
;
S Y=PSUSDT\1 X ^DD("DD") S PSUDTS=Y ; start date
S Y=PSUEDT\1 X ^DD("DD") S PSUDTE=Y ; end date
;
S X=PSUSNDR,DIC=40.8,DIC(0)="X",D="C" D IX^DIC
S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
S AMIS(1)="UD AMIS Summary for "_PSUDTS_" through "_PSUDTE_" for "_PSUDIVNM
;
S AMIS(2)="" ;Blank line
;
S AMIS(3)=" NET"
;
S AMIS(4)=" DOSES DOSES DOSES TOTAL AVG COST"
;
S AMIS(5)="DIVISION DISP RET DISP COST PER DOSE"
;
S $P(AMIS(6),"-",78)="" ;Separator bar
;
S PSULN=7
;
D DOSE
;
S $P(AMIS(PSULN),"-",78)="" S PSULN=PSULN+1 ;Separator bar
;
D DOST
;
F PSULN=PSULN:1:(PSULN+2) S AMIS(PSULN)="" ;Blank lines
S PULN=PSULN+1
;
S AMIS(PSULN)="Division Specialty Total Patient Days of Care"
;
S PSULN=PSULN+1
;
S $P(AMIS(PSULN),"-",78)="" S PSULN=PSULN+1 ;Separator bar
;
D DIV ;Calculate division data
D GTOT ;Calculate grand totals
Q
;
DOSE ;Set doses into array and set data into message
;
M DOSE=^XTMP(PSUUDSUB,"DOSES")
;
S PSUDIV=0
F S PSUDIV=$O(DOSE(PSUDIV)) Q:PSUDIV="" D
.S X=PSUDIV,DIC=40.8,DIC(0)="X",D="C" D IX^DIC
.S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
.S PSULINE=""
.S $E(PSULINE,1,17)=PSUDIVNM
.S $E(PSULINE,18,24)=$J($P(DOSE(PSUDIV),U,1),7)
.S $E(PSULINE,25,32)=$J($P(DOSE(PSUDIV),U,2),8)
.S $E(PSULINE,33,42)=$J($P(DOSE(PSUDIV),U,3),10)
.S $E(PSULINE,44,45)="$"
.S $E(PSULINE,46,53)=$J($P(DOSE(PSUDIV),U,4),8)
.S $E(PSULINE,57,58)="$"
.S $E(PSULINE,59,64)=$J($P(DOSE(PSUDIV),U,5),6)
.S AMIS(PSULN)=PSULINE S PSULN=PSULN+1
Q
;
DOST ;Set dose totals into array and set into message
;
M DOSTOT=^XTMP(PSUUDSUB,"DOSTOT")
I '$G(DOSTOT) S DOSTOT="0^0^0^0^0"
;
S PSULINE=""
S $E(PSULINE,1,17)="Total"
S $E(PSULINE,18,24)=$J($P(DOSTOT,U,1),7)
S $E(PSULINE,25,32)=$J($P(DOSTOT,U,2),8)
S $E(PSULINE,33,42)=$J($P(DOSTOT,U,3),10)
S $E(PSULINE,44,45)="$"
S $E(PSULINE,46,53)=$J($P(DOSTOT,U,4),8)
S $E(PSULINE,57,58)="$"
S $E(PSULINE,59,64)=$J($P(DOSTOT,U,5),6)
S AMIS(PSULN)=PSULINE S PSULN=PSULN+1
Q
;
DIV ;Set division data into array and create message
;
M SPEC=^XTMP(PSUUDSUB,"SPEC")
;
;
S PSUDV=0
F S PSUDV=$O(SPEC(PSUDV)) Q:PSUDV="" D
.S X=PSUDV,DIC=40.8,DIC(0)="X",D="C" D IX^DIC
.S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
.S PSUSPC=0
.N C
.F S PSUSPC=$O(SPEC(PSUDV,PSUSPC)) Q:PSUSPC="" D
..S PSULINE=""
..I '$D(C) S $E(PSULINE,1,17)=PSUDIVNM S C=""
..S $E(PSULINE,25,49)=$P(SPEC(PSUDV,PSUSPC),U,1)
..S $E(PSULINE,50,59)=$J($P(SPEC(PSUDV,PSUSPC),U,2),10)
..S AMIS(PSULN)=PSULINE S PSULN=PSULN+1
.D DIVTOT
Q
;
DIVTOT ;Create message lines for division totals
;
S $P(AMIS(PSULN),"-",78)="" S PSULN=PSULN+1 ;Separator bar
;
S PSULINE=""
S $E(PSULINE,1,40)=PSUDIVNM_" Total"
S $E(PSULINE,50,59)=$J(^XTMP(PSUUDSUB,"DIVTOT",PSUDV),10)
S AMIS(PSULN)=PSULINE
;
S PSULN=PSULN+1
;
F PSULN=PSULN:1:(PSULN+2) S AMIS(PSULN)="" ;Blank lines
S PSULN=PSULN+1
Q
;
GTOT ;Calculate grand total patient days of care for all divisions
;
S $P(AMIS(PSULN),"-",78)="" S PSULN=PSULN+1 ;Separator bar
;
S PSULINE=""
S $E(PSULINE,1,40)="Grand Total"
S $E(PSULINE,50,59)=$J($G(^XTMP(PSUUDSUB,"GTOT")),10)
S AMIS(PSULN)=PSULINE S PSULN=PSULN+1
;
;
Q
;
MAIL ;Send mailman message
;
;Do not send report if option selection includes 1,2,3,4,6
I $D(^XTMP("PSU_"_PSUJOB,"CBAMIS")) D Q
.M ^XTMP("PSU_"_PSUJOB,"UDCOMBO")=AMIS
.S ^XTMP("PSU_"_PSUJOB,"UDCOMBO",1)="INPATIENT:"
;
S X=PSUSNDR,DIC=40.8,DIC(0)="X",D="C" D IX^DIC
S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
;
S XMSUB="V. 4.0 PBMUD "_PSUMON_" "_PSUSNDR_" "_PSUDIVNM
S XMTEXT="AMIS("
S XMDUZ=DUZ
M XMY=PSUXMY
S XMCHAN=1
I PSUMASF!PSUDUZ!PSUPBMG D ^XMD
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUUD7 4405 printed Oct 16, 2024@18:29:25 Page 2
PSUUD7 ;BIR/DAM - UD AMIS Summary Message II;23 MAR 2004
+1 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
+2 ;
+3 ;Reference to file #40.8 supported by DBIA 2438
+4 ;
EN ;Entry point for MailMan message
+1 ;Called from PSUUD0
+2 ;
+3 ;Kill arrays to hold data
KILL AMIS,DOSE,DOSTOT,SPEC,DIVTOT,GTOT
+4 ;
+5 DO MSG
+6 ;Blank lines
FOR PSULN=PSULN:1:(PSULN+3)
SET AMIS(PSULN)=""
+7 MERGE ^XTMP("PSU_"_PSUJOB,"UDAMIS")=AMIS
+8 DO MAIL
+9 ;
+10 QUIT
+11 ;
MSG ;Set up lines in message
+1 ;
+2 ; start date
SET Y=PSUSDT\1
XECUTE ^DD("DD")
SET PSUDTS=Y
+3 ; end date
SET Y=PSUEDT\1
XECUTE ^DD("DD")
SET PSUDTE=Y
+4 ;
+5 SET X=PSUSNDR
SET DIC=40.8
SET DIC(0)="X"
SET D="C"
DO IX^DIC
+6 SET X=+Y
SET PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
+7 SET AMIS(1)="UD AMIS Summary for "_PSUDTS_" through "_PSUDTE_" for "_PSUDIVNM
+8 ;
+9 ;Blank line
SET AMIS(2)=""
+10 ;
+11 SET AMIS(3)=" NET"
+12 ;
+13 SET AMIS(4)=" DOSES DOSES DOSES TOTAL AVG COST"
+14 ;
+15 SET AMIS(5)="DIVISION DISP RET DISP COST PER DOSE"
+16 ;
+17 ;Separator bar
SET $PIECE(AMIS(6),"-",78)=""
+18 ;
+19 SET PSULN=7
+20 ;
+21 DO DOSE
+22 ;
+23 ;Separator bar
SET $PIECE(AMIS(PSULN),"-",78)=""
SET PSULN=PSULN+1
+24 ;
+25 DO DOST
+26 ;
+27 ;Blank lines
FOR PSULN=PSULN:1:(PSULN+2)
SET AMIS(PSULN)=""
+28 SET PULN=PSULN+1
+29 ;
+30 SET AMIS(PSULN)="Division Specialty Total Patient Days of Care"
+31 ;
+32 SET PSULN=PSULN+1
+33 ;
+34 ;Separator bar
SET $PIECE(AMIS(PSULN),"-",78)=""
SET PSULN=PSULN+1
+35 ;
+36 ;Calculate division data
DO DIV
+37 ;Calculate grand totals
DO GTOT
+38 QUIT
+39 ;
DOSE ;Set doses into array and set data into message
+1 ;
+2 MERGE DOSE=^XTMP(PSUUDSUB,"DOSES")
+3 ;
+4 SET PSUDIV=0
+5 FOR
SET PSUDIV=$ORDER(DOSE(PSUDIV))
if PSUDIV=""
QUIT
Begin DoDot:1
+6 SET X=PSUDIV
SET DIC=40.8
SET DIC(0)="X"
SET D="C"
DO IX^DIC
+7 SET X=+Y
SET PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
+8 SET PSULINE=""
+9 SET $EXTRACT(PSULINE,1,17)=PSUDIVNM
+10 SET $EXTRACT(PSULINE,18,24)=$JUSTIFY($PIECE(DOSE(PSUDIV),U,1),7)
+11 SET $EXTRACT(PSULINE,25,32)=$JUSTIFY($PIECE(DOSE(PSUDIV),U,2),8)
+12 SET $EXTRACT(PSULINE,33,42)=$JUSTIFY($PIECE(DOSE(PSUDIV),U,3),10)
+13 SET $EXTRACT(PSULINE,44,45)="$"
+14 SET $EXTRACT(PSULINE,46,53)=$JUSTIFY($PIECE(DOSE(PSUDIV),U,4),8)
+15 SET $EXTRACT(PSULINE,57,58)="$"
+16 SET $EXTRACT(PSULINE,59,64)=$JUSTIFY($PIECE(DOSE(PSUDIV),U,5),6)
+17 SET AMIS(PSULN)=PSULINE
SET PSULN=PSULN+1
End DoDot:1
+18 QUIT
+19 ;
DOST ;Set dose totals into array and set into message
+1 ;
+2 MERGE DOSTOT=^XTMP(PSUUDSUB,"DOSTOT")
+3 IF '$GET(DOSTOT)
SET DOSTOT="0^0^0^0^0"
+4 ;
+5 SET PSULINE=""
+6 SET $EXTRACT(PSULINE,1,17)="Total"
+7 SET $EXTRACT(PSULINE,18,24)=$JUSTIFY($PIECE(DOSTOT,U,1),7)
+8 SET $EXTRACT(PSULINE,25,32)=$JUSTIFY($PIECE(DOSTOT,U,2),8)
+9 SET $EXTRACT(PSULINE,33,42)=$JUSTIFY($PIECE(DOSTOT,U,3),10)
+10 SET $EXTRACT(PSULINE,44,45)="$"
+11 SET $EXTRACT(PSULINE,46,53)=$JUSTIFY($PIECE(DOSTOT,U,4),8)
+12 SET $EXTRACT(PSULINE,57,58)="$"
+13 SET $EXTRACT(PSULINE,59,64)=$JUSTIFY($PIECE(DOSTOT,U,5),6)
+14 SET AMIS(PSULN)=PSULINE
SET PSULN=PSULN+1
+15 QUIT
+16 ;
DIV ;Set division data into array and create message
+1 ;
+2 MERGE SPEC=^XTMP(PSUUDSUB,"SPEC")
+3 ;
+4 ;
+5 SET PSUDV=0
+6 FOR
SET PSUDV=$ORDER(SPEC(PSUDV))
if PSUDV=""
QUIT
Begin DoDot:1
+7 SET X=PSUDV
SET DIC=40.8
SET DIC(0)="X"
SET D="C"
DO IX^DIC
+8 SET X=+Y
SET PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
+9 SET PSUSPC=0
+10 NEW C
+11 FOR
SET PSUSPC=$ORDER(SPEC(PSUDV,PSUSPC))
if PSUSPC=""
QUIT
Begin DoDot:2
+12 SET PSULINE=""
+13 IF '$DATA(C)
SET $EXTRACT(PSULINE,1,17)=PSUDIVNM
SET C=""
+14 SET $EXTRACT(PSULINE,25,49)=$PIECE(SPEC(PSUDV,PSUSPC),U,1)
+15 SET $EXTRACT(PSULINE,50,59)=$JUSTIFY($PIECE(SPEC(PSUDV,PSUSPC),U,2),10)
+16 SET AMIS(PSULN)=PSULINE
SET PSULN=PSULN+1
End DoDot:2
+17 DO DIVTOT
End DoDot:1
+18 QUIT
+19 ;
DIVTOT ;Create message lines for division totals
+1 ;
+2 ;Separator bar
SET $PIECE(AMIS(PSULN),"-",78)=""
SET PSULN=PSULN+1
+3 ;
+4 SET PSULINE=""
+5 SET $EXTRACT(PSULINE,1,40)=PSUDIVNM_" Total"
+6 SET $EXTRACT(PSULINE,50,59)=$JUSTIFY(^XTMP(PSUUDSUB,"DIVTOT",PSUDV),10)
+7 SET AMIS(PSULN)=PSULINE
+8 ;
+9 SET PSULN=PSULN+1
+10 ;
+11 ;Blank lines
FOR PSULN=PSULN:1:(PSULN+2)
SET AMIS(PSULN)=""
+12 SET PSULN=PSULN+1
+13 QUIT
+14 ;
GTOT ;Calculate grand total patient days of care for all divisions
+1 ;
+2 ;Separator bar
SET $PIECE(AMIS(PSULN),"-",78)=""
SET PSULN=PSULN+1
+3 ;
+4 SET PSULINE=""
+5 SET $EXTRACT(PSULINE,1,40)="Grand Total"
+6 SET $EXTRACT(PSULINE,50,59)=$JUSTIFY($GET(^XTMP(PSUUDSUB,"GTOT")),10)
+7 SET AMIS(PSULN)=PSULINE
SET PSULN=PSULN+1
+8 ;
+9 ;
+10 QUIT
+11 ;
MAIL ;Send mailman message
+1 ;
+2 ;Do not send report if option selection includes 1,2,3,4,6
+3 IF $DATA(^XTMP("PSU_"_PSUJOB,"CBAMIS"))
Begin DoDot:1
+4 MERGE ^XTMP("PSU_"_PSUJOB,"UDCOMBO")=AMIS
+5 SET ^XTMP("PSU_"_PSUJOB,"UDCOMBO",1)="INPATIENT:"
End DoDot:1
QUIT
+6 ;
+7 SET X=PSUSNDR
SET DIC=40.8
SET DIC(0)="X"
SET D="C"
DO IX^DIC
+8 SET X=+Y
SET PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
+9 ;
+10 SET XMSUB="V. 4.0 PBMUD "_PSUMON_" "_PSUSNDR_" "_PSUDIVNM
+11 SET XMTEXT="AMIS("
+12 SET XMDUZ=DUZ
+13 MERGE XMY=PSUXMY
+14 SET XMCHAN=1
+15 IF PSUMASF!PSUDUZ!PSUPBMG
DO ^XMD
+16 ;
+17 QUIT
