PSULR5 ;BIR/PDW - LAB extract summary message generator ;10 JUL 1999
;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
;DBIA(s)
; Reference to file 40.8 supported by DBIA 2438
;
EN ;EP generate Total & Cost summary
EN1 N PSUITT,PSUREC
S:'$D(PSULRJOB) PSULRJOB=PSUJOB
S:'$D(PSULRSUB) PSULRSUB="PSULR_"_PSULRJOB
;
;S PSUSDT=2970101
;S PSUEDT=2980501
I '$D(^XTMP(PSULRSUB,"RECORDS")) G NODATA
DIV ;EP Loop by Division
S PSUDIV="" F S PSUDIV=$O(^XTMP(PSULRSUB,"SUMMARY",PSUDIV)) Q:PSUDIV="" D MESSAGE
Q
;
MESSAGE ;EP Generate Summary Messages for a Division
;
;S X=PSUDIV,DIC=40.8,DIC(0)="X",D="C" D IX^DIC ;**1
;S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
MSG1 ; Generate 1st summary message
;
S PSUT=0,PSUP=0 ; test & patient counters
; loop to get totals from records stored
S DFN=0
F S DFN=$O(^XTMP(PSULRSUB,"SUMMARY",PSUDIV,DFN)) Q:DFN'>0 S PSUP=PSUP+1 D
. S PSUDC="" F S PSUDC=$O(^XTMP(PSULRSUB,"SUMMARY",PSUDIV,DFN,PSUDC)) Q:PSUDC="" D
.. S PSUND=0
.. F S PSUND=$O(^XTMP(PSULRSUB,"SUMMARY",PSUDIV,DFN,PSUDC,PSUND)) Q:PSUND'>0 S PSUT=PSUT+1
;
S XMDUZ=DUZ
M XMY=PSUXMYS1
;
S Y=PSUSDT X ^DD("DD") S PSUDTS=Y ; start date
S Y=PSUEDT X ^DD("DD") S PSUDTE=Y ; end date
N PSUMSG
S X=PSUDIV,DIC=40.8,DIC(0)="X",D="C" D IX^DIC ;**1
S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
;
I $D(^XTMP("PSU_"_PSUJOB,"DIV",PSUDIV)) D
.;VMP OIFO BAY PINES;ELR;PSU*3.0*31
.I '$L($P($G(^XTMP("PSU_"_PSUJOB,"DIV",PSUDIV)),U,1)) Q
.S PSUDIVNM=$P(^XTMP("PSU_"_PSUJOB,"DIV",PSUDIV),U,1)
;
S PSUMSG(1)=" Laboratory Statistical Summary"
S PSUMSG(2)=" "_PSUDTS_" through "_PSUDTE_" for "_PSUDIVNM
S PSUMSG(3)=" "
S PSUMSG(4)="Total Patients "_PSUP
S PSUMSG(5)="Total Laboratory Tests "_PSUT
S PSUMSG(6)=" "
S XMSUB="V. 4.0 PBMLR "_$G(PSUMON)_" "_PSUDIV_" "_PSUDIVNM
S XMTEXT="PSUMSG("
S XMCHAN=1
D ^XMD
M ^XTMP(PSULRSUB,"REPORT1",PSUDIV)=PSUMSG
K PSUMSG
;
MSG2 ; SUMMARY BY PATIENT
;
;
S PSUG="^XTMP(PSULRSUB,""REPORT2"",PSUDIV)"
K @PSUG
S @PSUG@(1)=" Laboratory Data Summary"
S @PSUG@(2)=" "_PSUDTS_" through "_PSUDTE_" for "_PSUDIVNM
S @PSUG@(3)=" "
S X="Patient SSN"
S X=$$SETSTR^VALM1("VA CODE",X,15,7)
S X=$$SETSTR^VALM1("Laboratory",X,24,10)
S X=$$SETSTR^VALM1("Results",X,42,7)
S X=$$SETSTR^VALM1("Flag",X,57,4)
S X=$$SETSTR^VALM1("Date/Time Taken",X,63,15)
S @PSUG@(4)=X
S X="",$P(X,"-",79)=""
S @PSUG@(5)=X
S PSULC=5
; loop records stored
S DFN=0,DFN1="",PSUCD1=""
F S DFN=$O(^XTMP(PSULRSUB,"SUMMARY",PSUDIV,DFN)) Q:DFN'>0 D S DFN1=DFN
. ; loop drug codes
. S PSUCD=""
. F S PSUCD=$O(^XTMP(PSULRSUB,"SUMMARY",PSUDIV,DFN,PSUCD)) Q:PSUCD="" D S PSUCD1=PSUCD
.. ; loop tests
.. S PSUND=0
.. F S PSUND=$O(^XTMP(PSULRSUB,"SUMMARY",PSUDIV,DFN,PSUCD,PSUND)) Q:PSUND'>0 D SET
;
S @PSUG@(PSULC+1)=" "
S XMSUB="V. 4.0 PBMLR "_$G(PSUMON)_" "_PSUDIV_" "_PSUDIVNM
S XMTEXT="^XTMP(PSULRSUB,""REPORT2"",PSUDIV,"
S XMCHAN=1
M XMY=PSUXMYS2
I '$G(PSUSMRY) D ^XMD
Q
;
SET ;EP Set data into message
;
S X=^XTMP(PSULRSUB,"SUMMARY",PSUDIV,DFN,PSUCD,PSUND)
S PSULRT=$P(X,U),PSULRR=$P(X,U,2)
S PSULD=$P(X,U,3),PSULRF=$P(X,U,4)
S PSULD0=$E(PSULD,4,5)_"/"_$E(PSULD,6,7)_"/"_$E(PSULD,2,3)
S X=$P(PSULD,".",2),X=$E(X,1,4) F Q:$L(X)=4 S X=X_0 ; fill time
S PSULD=PSULD0_" "_X
S X=""
I DFN=DFN1
E D PID^VADPT S X=$TR(VA("PID"),"-",""),DFN1=DFN,PSUCD1="" K VA
I PSUCD1=PSUCD
E S X=$$SETSTR^VALM1(PSUCD,X,15,5) S PSUCD1=PSUCD
S X=$$SETSTR^VALM1(PSULRT,X,24,$L(PSULRT))
S X=$$SETSTR^VALM1(PSULRR,X,42,$L(PSULRR))
S X=$$SETSTR^VALM1(PSULRF,X,57,$L(PSULRF))
S X=$$SETSTR^VALM1(PSULD,X,63,$L(PSULD))
S PSULC=PSULC+1
S @PSUG@(PSULC)=X
;
Q
NODATA ;EP SEND NO DATA MESSAGE
S XMDUZ=DUZ
M XMY=PSUXMYS1
;
S Y=PSUSDT X ^DD("DD") S PSUDTS=Y ; start date
S Y=PSUEDT X ^DD("DD") S PSUDTE=Y ; end date
S PSUDIV=PSUSNDR
S X=PSUDIV,DIC=40.8,DIC(0)="X",D="C" D IX^DIC ;**1
S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
S XMSUB="V. 4.0 PBMLR "_$G(PSUMON)_" "_PSUDIV_" "_PSUDIVNM
S XMTEXT="^XTMP(PSULRSUB,""REPORT2"",PSUDIV,"
S XMCHAN=1
K X
S X(1)=" Laboratory Statistical Summary"
S X(2)=" "_PSUDTS_" through "_PSUDTE_" for "_PSUDIVNM
S X(3)=" "
S X(4)="No data to report"
S X(5)=" "
S XMTEXT="X("
S:$G(PSUDUZ) XMY(PSUDUZ)=""
D ^XMD
M ^XTMP(PSULRSUB,"REPORT1",PSUDIV)=X
S XMSUB="V. 4.0 PBMPR "_$G(PSUMON)_" "_PSUDIV_" "_PSUDIVNM
S X(1)=" Laboratory Data Summary"
M ^XTMP(PSULRSUB,"REPORT2",PSUDIV)=X ;store for print cycle
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSULR5 4684 printed Sep 23, 2025@20:03:37 Page 2
PSULR5 ;BIR/PDW - LAB extract summary message generator ;10 JUL 1999
+1 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
+2 ;DBIA(s)
+3 ; Reference to file 40.8 supported by DBIA 2438
+4 ;
EN ;EP generate Total & Cost summary
EN1 NEW PSUITT,PSUREC
+1 if '$DATA(PSULRJOB)
SET PSULRJOB=PSUJOB
+2 if '$DATA(PSULRSUB)
SET PSULRSUB="PSULR_"_PSULRJOB
+3 ;
+4 ;S PSUSDT=2970101
+5 ;S PSUEDT=2980501
+6 IF '$DATA(^XTMP(PSULRSUB,"RECORDS"))
GOTO NODATA
DIV ;EP Loop by Division
+1 SET PSUDIV=""
FOR
SET PSUDIV=$ORDER(^XTMP(PSULRSUB,"SUMMARY",PSUDIV))
if PSUDIV=""
QUIT
DO MESSAGE
+2 QUIT
+3 ;
MESSAGE ;EP Generate Summary Messages for a Division
+1 ;
+2 ;S X=PSUDIV,DIC=40.8,DIC(0)="X",D="C" D IX^DIC ;**1
+3 ;S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
MSG1 ; Generate 1st summary message
+1 ;
+2 ; test & patient counters
SET PSUT=0
SET PSUP=0
+3 ; loop to get totals from records stored
+4 SET DFN=0
+5 FOR
SET DFN=$ORDER(^XTMP(PSULRSUB,"SUMMARY",PSUDIV,DFN))
if DFN'>0
QUIT
SET PSUP=PSUP+1
Begin DoDot:1
+6 SET PSUDC=""
FOR
SET PSUDC=$ORDER(^XTMP(PSULRSUB,"SUMMARY",PSUDIV,DFN,PSUDC))
if PSUDC=""
QUIT
Begin DoDot:2
+7 SET PSUND=0
+8 FOR
SET PSUND=$ORDER(^XTMP(PSULRSUB,"SUMMARY",PSUDIV,DFN,PSUDC,PSUND))
if PSUND'>0
QUIT
SET PSUT=PSUT+1
End DoDot:2
End DoDot:1
+9 ;
+10 SET XMDUZ=DUZ
+11 MERGE XMY=PSUXMYS1
+12 ;
+13 ; start date
SET Y=PSUSDT
XECUTE ^DD("DD")
SET PSUDTS=Y
+14 ; end date
SET Y=PSUEDT
XECUTE ^DD("DD")
SET PSUDTE=Y
+15 NEW PSUMSG
+16 ;**1
SET X=PSUDIV
SET DIC=40.8
SET DIC(0)="X"
SET D="C"
DO IX^DIC
+17 SET X=+Y
SET PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
+18 ;
+19 IF $DATA(^XTMP("PSU_"_PSUJOB,"DIV",PSUDIV))
Begin DoDot:1
+20 ;VMP OIFO BAY PINES;ELR;PSU*3.0*31
+21 IF '$LENGTH($PIECE($GET(^XTMP("PSU_"_PSUJOB,"DIV",PSUDIV)),U,1))
QUIT
+22 SET PSUDIVNM=$PIECE(^XTMP("PSU_"_PSUJOB,"DIV",PSUDIV),U,1)
End DoDot:1
+23 ;
+24 SET PSUMSG(1)=" Laboratory Statistical Summary"
+25 SET PSUMSG(2)=" "_PSUDTS_" through "_PSUDTE_" for "_PSUDIVNM
+26 SET PSUMSG(3)=" "
+27 SET PSUMSG(4)="Total Patients "_PSUP
+28 SET PSUMSG(5)="Total Laboratory Tests "_PSUT
+29 SET PSUMSG(6)=" "
+30 SET XMSUB="V. 4.0 PBMLR "_$GET(PSUMON)_" "_PSUDIV_" "_PSUDIVNM
+31 SET XMTEXT="PSUMSG("
+32 SET XMCHAN=1
+33 DO ^XMD
+34 MERGE ^XTMP(PSULRSUB,"REPORT1",PSUDIV)=PSUMSG
+35 KILL PSUMSG
+36 ;
MSG2 ; SUMMARY BY PATIENT
+1 ;
+2 ;
+3 SET PSUG="^XTMP(PSULRSUB,""REPORT2"",PSUDIV)"
+4 KILL @PSUG
+5 SET @PSUG@(1)=" Laboratory Data Summary"
+6 SET @PSUG@(2)=" "_PSUDTS_" through "_PSUDTE_" for "_PSUDIVNM
+7 SET @PSUG@(3)=" "
+8 SET X="Patient SSN"
+9 SET X=$$SETSTR^VALM1("VA CODE",X,15,7)
+10 SET X=$$SETSTR^VALM1("Laboratory",X,24,10)
+11 SET X=$$SETSTR^VALM1("Results",X,42,7)
+12 SET X=$$SETSTR^VALM1("Flag",X,57,4)
+13 SET X=$$SETSTR^VALM1("Date/Time Taken",X,63,15)
+14 SET @PSUG@(4)=X
+15 SET X=""
SET $PIECE(X,"-",79)=""
+16 SET @PSUG@(5)=X
+17 SET PSULC=5
+18 ; loop records stored
+19 SET DFN=0
SET DFN1=""
SET PSUCD1=""
+20 FOR
SET DFN=$ORDER(^XTMP(PSULRSUB,"SUMMARY",PSUDIV,DFN))
if DFN'>0
QUIT
Begin DoDot:1
+21 ; loop drug codes
+22 SET PSUCD=""
+23 FOR
SET PSUCD=$ORDER(^XTMP(PSULRSUB,"SUMMARY",PSUDIV,DFN,PSUCD))
if PSUCD=""
QUIT
Begin DoDot:2
+24 ; loop tests
+25 SET PSUND=0
+26 FOR
SET PSUND=$ORDER(^XTMP(PSULRSUB,"SUMMARY",PSUDIV,DFN,PSUCD,PSUND))
if PSUND'>0
QUIT
DO SET
End DoDot:2
SET PSUCD1=PSUCD
End DoDot:1
SET DFN1=DFN
+27 ;
+28 SET @PSUG@(PSULC+1)=" "
+29 SET XMSUB="V. 4.0 PBMLR "_$GET(PSUMON)_" "_PSUDIV_" "_PSUDIVNM
+30 SET XMTEXT="^XTMP(PSULRSUB,""REPORT2"",PSUDIV,"
+31 SET XMCHAN=1
+32 MERGE XMY=PSUXMYS2
+33 IF '$GET(PSUSMRY)
DO ^XMD
+34 QUIT
+35 ;
SET ;EP Set data into message
+1 ;
+2 SET X=^XTMP(PSULRSUB,"SUMMARY",PSUDIV,DFN,PSUCD,PSUND)
+3 SET PSULRT=$PIECE(X,U)
SET PSULRR=$PIECE(X,U,2)
+4 SET PSULD=$PIECE(X,U,3)
SET PSULRF=$PIECE(X,U,4)
+5 SET PSULD0=$EXTRACT(PSULD,4,5)_"/"_$EXTRACT(PSULD,6,7)_"/"_$EXTRACT(PSULD,2,3)
+6 ; fill time
SET X=$PIECE(PSULD,".",2)
SET X=$EXTRACT(X,1,4)
FOR
if $LENGTH(X)=4
QUIT
SET X=X_0
+7 SET PSULD=PSULD0_" "_X
+8 SET X=""
+9 IF DFN=DFN1
+10 IF '$TEST
DO PID^VADPT
SET X=$TRANSLATE(VA("PID"),"-","")
SET DFN1=DFN
SET PSUCD1=""
KILL VA
+11 IF PSUCD1=PSUCD
+12 IF '$TEST
SET X=$$SETSTR^VALM1(PSUCD,X,15,5)
SET PSUCD1=PSUCD
+13 SET X=$$SETSTR^VALM1(PSULRT,X,24,$LENGTH(PSULRT))
+14 SET X=$$SETSTR^VALM1(PSULRR,X,42,$LENGTH(PSULRR))
+15 SET X=$$SETSTR^VALM1(PSULRF,X,57,$LENGTH(PSULRF))
+16 SET X=$$SETSTR^VALM1(PSULD,X,63,$LENGTH(PSULD))
+17 SET PSULC=PSULC+1
+18 SET @PSUG@(PSULC)=X
+19 ;
+20 QUIT
NODATA ;EP SEND NO DATA MESSAGE
+1 SET XMDUZ=DUZ
+2 MERGE XMY=PSUXMYS1
+3 ;
+4 ; start date
SET Y=PSUSDT
XECUTE ^DD("DD")
SET PSUDTS=Y
+5 ; end date
SET Y=PSUEDT
XECUTE ^DD("DD")
SET PSUDTE=Y
+6 SET PSUDIV=PSUSNDR
+7 ;**1
SET X=PSUDIV
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 XMSUB="V. 4.0 PBMLR "_$GET(PSUMON)_" "_PSUDIV_" "_PSUDIVNM
+10 SET XMTEXT="^XTMP(PSULRSUB,""REPORT2"",PSUDIV,"
+11 SET XMCHAN=1
+12 KILL X
+13 SET X(1)=" Laboratory Statistical Summary"
+14 SET X(2)=" "_PSUDTS_" through "_PSUDTE_" for "_PSUDIVNM
+15 SET X(3)=" "
+16 SET X(4)="No data to report"
+17 SET X(5)=" "
+18 SET XMTEXT="X("
+19 if $GET(PSUDUZ)
SET XMY(PSUDUZ)=""
+20 DO ^XMD
+21 MERGE ^XTMP(PSULRSUB,"REPORT1",PSUDIV)=X
+22 SET XMSUB="V. 4.0 PBMPR "_$GET(PSUMON)_" "_PSUDIV_" "_PSUDIVNM
+23 SET X(1)=" Laboratory Data Summary"
+24 ;store for print cycle
MERGE ^XTMP(PSULRSUB,"REPORT2",PSUDIV)=X
+25 QUIT
