PSUOP4 ;BIR/CFL - PSU PBM Outpatient Pharmacy create mailman messages ;10 JUL 1999
;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
;
;DBIA(s)
; Reference to file #4.3 supported by DBIA 2496
; Reference to file #59 supported by DBIA 2510
; Reference to file #4 supported by DBIA 10090
;
EN ;
;
S $P(PSUDASH,"-",100)=""
S $P(PSUFILL," ",100)=""
;Organize index of ^XTMP("DATA") global
S (PSUDV,PSUTMP)=""
F S PSUDV=$O(^XTMP(PSUOPSUB,"DATA",PSUDV)) Q:PSUDV="" D
.S PSULCT=0
.S PSURXIEN=""
.F S PSURXIEN=$O(^XTMP(PSUOPSUB,"DATA",PSUDV,PSURXIEN)) Q:PSURXIEN="" D
..S PSURCT=0
..F S PSURCT=$O(^XTMP(PSUOPSUB,"DATA",PSUDV,PSURXIEN,PSURCT)) Q:PSURCT="" D
...D DATA^PSUOP7 ;Gather data for AMIS summary report
...S PSULCT=PSULCT+1
...S ^XTMP(PSUOPSUB,"RECORDS",PSUDV,PSULCT)=^XTMP(PSUOPSUB,"DATA",PSUDV,PSURXIEN,PSURCT,1)
...S PSULCT=PSULCT+1
...S ^XTMP(PSUOPSUB,"RECORDS",PSUDV,PSULCT)=^XTMP(PSUOPSUB,"DATA",PSUDV,PSURXIEN,PSURCT,2)
...;S PSULCT=PSULCT+1
...;S ^XTMP(PSUOPSUB,"RECORDS",PSUDV,PSULCT)=^XTMP(PSUOPSUB,"DATA",PSUDV,PSURXIEN,PSURCT,3)
;
;
;Create global for Patient Demographics summary message
M ^XTMP("PSU_"_PSUJOB,"PSUDIVPT")=^XTMP(PSUOPSUB,"RECORDS")
S PSUST=0
F S PSUST=$O(^XTMP("PSU_"_PSUJOB,"PSUDIVPT",PSUST)) Q:PSUST="" D
.S PSUST1=0
.F S PSUST1=$O(^XTMP("PSU_"_PSUJOB,"PSUDIVPT",PSUST,PSUST1)) Q:PSUST1="" D
..I $P(^XTMP("PSU_"_PSUJOB,"PSUDIVPT",PSUST,PSUST1),U,1)["*" D
...K ^XTMP("PSU_"_PSUJOB,"PSUDIVPT",PSUST,PSUST1)
;
MSG ;Set up the number of lines and messages for mailman
;
S PSUNOREC="",NONE=""
S PSUMSGT("M")=0,PSUMSGT("L")=0
I '$D(^XTMP(PSUOPSUB,"RECORDS")) D NODATA Q ;Do not go any further if there is no data to report
S PSUDIV=0,Z=0
F S PSUDIV=$O(^XTMP(PSUOPSUB,"RECORDS",PSUDIV)) Q:PSUDIV="" D
.S X=PSUDIV,DIC=59,DIC(0)="XM" D ^DIC ;;1
.S X=+Y,PSUDIVNM=$$VAL^PSUTL(59,X,.01)
.;VMP OIFO BAY PINES;ELR;PSU*3.0*31
.I '$L(PSUDIVNM) S X=PSUDIV D DIVNM^PSUOP6
.I PSUMASF!PSUDUZ!PSUPBMG D
..I 'PSUSMRY D XMD,SETCNT
.D RECLOOP^PSUOP5,RECSUM^PSUOP5 ; send statistical summary
.I 'PSUSMRY D DRUGSUM^PSUOP5 ; send drug summary on condition
Q
XMD ;
NEW PSUMAX,PSULC,PSUTMC,PSUTLC,PSUMC
S PSUMAX=$$VAL^PSUTL(4.3,1,8.3)
S PSUMAX=$S(PSUMAX="":10000,PSUMAX>10000:10000,1:PSUMAX)
K ^XTMP(PSUOPSUB,"XMD")
S PSUMC=1,PSUMLC=0
F PSULC=1:1 S X=$G(^XTMP(PSUOPSUB,"RECORDS",PSUDIV,PSULC)) Q:X="" D
.S PSUMLC=PSUMLC+1
.I PSUMLC>PSUMAX D
..I $E(X,1)="*" D
...S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,1)=^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-1)
...K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-1)
...S PSUMC=PSUMC+1,PSUMLC=2
..I $E(X,1)'="*" S PSUMC=PSUMC+1,PSUMLC=1 ; + message
.I $L(X)<250 S ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC)=X Q
.F I=250:-1:1 S Z=$E(X,I) Q:Z="^"
.S ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC)=$E(X,1,I)
.S PSUMLC=PSUMLC+1
.S ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC)="*"_$E(X,I+1,999)
;
; Count Lines sent
S PSUTLC=0
F PSUM=1:1:PSUMC S X=$O(^XTMP(PSUOPSUB,"XMD",PSUM,""),-1),PSUTLC=PSUTLC+X
;
; Transmit Messages
VARS ; Setup variables for contents
F PSUM=1:1:PSUMC 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 XMSUB="V. 4.0 PBMOP "_PSUMON_" "_PSUM_"/"_PSUMC_" "_PSUDIV_" "_PSUDIVNM
.S XMTEXT="^XTMP(PSUOPSUB,""XMD"",PSUM,"
.S XMCHAN=1
.I PSUMASF!PSUDUZ!PSUPBMG D
..M XMY=PSUXMYH
.I 'PSUMASF M XMY=PSUXMYS1
.D ^XMD
;
S:NONE PSUTLC=0
S PSUMSG("M")=PSUMC
S PSUMSG("L")=PSUTLC
Q
NODATA ;Send "No data to report" message
S ^XTMP(PSUOPSUB,"RECORDS",PSUSNDR,1)="No data to report"
S NONE=1,PSUDIV=PSUSNDR
S ^XTMP("PSU_"_PSUJOB,"PSUNONE","RX")=""
;VMP OIFO BAY PINES;ELR;PSU*3.0*31
S X=PSUDIV D DIVNM^PSUOP6
D XMD
SETCNT ;Set message count and line count
S PSUMSGT(PSUDIV,"M")=$G(PSUMSGT(PSUDIV,"M"))+PSUMSG("M")
S PSUMSGT(PSUDIV,"L")=$G(PSUMSGT(PSUDIV,"L"))+PSUMSG("L")
S ^XTMP("PSU_"_PSUJOB,"CONFIRM",PSUDIV,PSUOPTN,"M")=PSUMSGT(PSUDIV,"M")
S ^XTMP("PSU_"_PSUJOB,"CONFIRM",PSUDIV,PSUOPTN,"L")=PSUMSGT(PSUDIV,"L")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUOP4 4096 printed Sep 23, 2025@20:03:50 Page 2
PSUOP4 ;BIR/CFL - PSU PBM Outpatient Pharmacy create mailman messages ;10 JUL 1999
+1 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
+2 ;
+3 ;DBIA(s)
+4 ; Reference to file #4.3 supported by DBIA 2496
+5 ; Reference to file #59 supported by DBIA 2510
+6 ; Reference to file #4 supported by DBIA 10090
+7 ;
EN ;
+1 ;
+2 SET $PIECE(PSUDASH,"-",100)=""
+3 SET $PIECE(PSUFILL," ",100)=""
+4 ;Organize index of ^XTMP("DATA") global
+5 SET (PSUDV,PSUTMP)=""
+6 FOR
SET PSUDV=$ORDER(^XTMP(PSUOPSUB,"DATA",PSUDV))
if PSUDV=""
QUIT
Begin DoDot:1
+7 SET PSULCT=0
+8 SET PSURXIEN=""
+9 FOR
SET PSURXIEN=$ORDER(^XTMP(PSUOPSUB,"DATA",PSUDV,PSURXIEN))
if PSURXIEN=""
QUIT
Begin DoDot:2
+10 SET PSURCT=0
+11 FOR
SET PSURCT=$ORDER(^XTMP(PSUOPSUB,"DATA",PSUDV,PSURXIEN,PSURCT))
if PSURCT=""
QUIT
Begin DoDot:3
+12 ;Gather data for AMIS summary report
DO DATA^PSUOP7
+13 SET PSULCT=PSULCT+1
+14 SET ^XTMP(PSUOPSUB,"RECORDS",PSUDV,PSULCT)=^XTMP(PSUOPSUB,"DATA",PSUDV,PSURXIEN,PSURCT,1)
+15 SET PSULCT=PSULCT+1
+16 SET ^XTMP(PSUOPSUB,"RECORDS",PSUDV,PSULCT)=^XTMP(PSUOPSUB,"DATA",PSUDV,PSURXIEN,PSURCT,2)
+17 ;S PSULCT=PSULCT+1
+18 ;S ^XTMP(PSUOPSUB,"RECORDS",PSUDV,PSULCT)=^XTMP(PSUOPSUB,"DATA",PSUDV,PSURXIEN,PSURCT,3)
End DoDot:3
End DoDot:2
End DoDot:1
+19 ;
+20 ;
+21 ;Create global for Patient Demographics summary message
+22 MERGE ^XTMP("PSU_"_PSUJOB,"PSUDIVPT")=^XTMP(PSUOPSUB,"RECORDS")
+23 SET PSUST=0
+24 FOR
SET PSUST=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUDIVPT",PSUST))
if PSUST=""
QUIT
Begin DoDot:1
+25 SET PSUST1=0
+26 FOR
SET PSUST1=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUDIVPT",PSUST,PSUST1))
if PSUST1=""
QUIT
Begin DoDot:2
+27 IF $PIECE(^XTMP("PSU_"_PSUJOB,"PSUDIVPT",PSUST,PSUST1),U,1)["*"
Begin DoDot:3
+28 KILL ^XTMP("PSU_"_PSUJOB,"PSUDIVPT",PSUST,PSUST1)
End DoDot:3
End DoDot:2
End DoDot:1
+29 ;
MSG ;Set up the number of lines and messages for mailman
+1 ;
+2 SET PSUNOREC=""
SET NONE=""
+3 SET PSUMSGT("M")=0
SET PSUMSGT("L")=0
+4 ;Do not go any further if there is no data to report
IF '$DATA(^XTMP(PSUOPSUB,"RECORDS"))
DO NODATA
QUIT
+5 SET PSUDIV=0
SET Z=0
+6 FOR
SET PSUDIV=$ORDER(^XTMP(PSUOPSUB,"RECORDS",PSUDIV))
if PSUDIV=""
QUIT
Begin DoDot:1
+7 ;;1
SET X=PSUDIV
SET DIC=59
SET DIC(0)="XM"
DO ^DIC
+8 SET X=+Y
SET PSUDIVNM=$$VAL^PSUTL(59,X,.01)
+9 ;VMP OIFO BAY PINES;ELR;PSU*3.0*31
+10 IF '$LENGTH(PSUDIVNM)
SET X=PSUDIV
DO DIVNM^PSUOP6
+11 IF PSUMASF!PSUDUZ!PSUPBMG
Begin DoDot:2
+12 IF 'PSUSMRY
DO XMD
DO SETCNT
End DoDot:2
+13 ; send statistical summary
DO RECLOOP^PSUOP5
DO RECSUM^PSUOP5
+14 ; send drug summary on condition
IF 'PSUSMRY
DO DRUGSUM^PSUOP5
End DoDot:1
+15 QUIT
XMD ;
+1 NEW PSUMAX,PSULC,PSUTMC,PSUTLC,PSUMC
+2 SET PSUMAX=$$VAL^PSUTL(4.3,1,8.3)
+3 SET PSUMAX=$SELECT(PSUMAX="":10000,PSUMAX>10000:10000,1:PSUMAX)
+4 KILL ^XTMP(PSUOPSUB,"XMD")
+5 SET PSUMC=1
SET PSUMLC=0
+6 FOR PSULC=1:1
SET X=$GET(^XTMP(PSUOPSUB,"RECORDS",PSUDIV,PSULC))
if X=""
QUIT
Begin DoDot:1
+7 SET PSUMLC=PSUMLC+1
+8 IF PSUMLC>PSUMAX
Begin DoDot:2
+9 IF $EXTRACT(X,1)="*"
Begin DoDot:3
+10 SET ^XTMP(PSUOPSUB,"XMD",PSUMC+1,1)=^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-1)
+11 KILL ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-1)
+12 SET PSUMC=PSUMC+1
SET PSUMLC=2
End DoDot:3
+13 ; + message
IF $EXTRACT(X,1)'="*"
SET PSUMC=PSUMC+1
SET PSUMLC=1
End DoDot:2
+14 IF $LENGTH(X)<250
SET ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC)=X
QUIT
+15 FOR I=250:-1:1
SET Z=$EXTRACT(X,I)
if Z="^"
QUIT
+16 SET ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC)=$EXTRACT(X,1,I)
+17 SET PSUMLC=PSUMLC+1
+18 SET ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC)="*"_$EXTRACT(X,I+1,999)
End DoDot:1
+19 ;
+20 ; Count Lines sent
+21 SET PSUTLC=0
+22 FOR PSUM=1:1:PSUMC
SET X=$ORDER(^XTMP(PSUOPSUB,"XMD",PSUM,""),-1)
SET PSUTLC=PSUTLC+X
+23 ;
+24 ; Transmit Messages
VARS ; Setup variables for contents
+1 FOR PSUM=1:1:PSUMC
Begin DoDot:1
+2 SET X=PSUDIV
SET DIC=40.8
SET DIC(0)="X"
SET D="C"
DO IX^DIC
+3 SET X=+Y
SET PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
+4 SET XMSUB="V. 4.0 PBMOP "_PSUMON_" "_PSUM_"/"_PSUMC_" "_PSUDIV_" "_PSUDIVNM
+5 SET XMTEXT="^XTMP(PSUOPSUB,""XMD"",PSUM,"
+6 SET XMCHAN=1
+7 IF PSUMASF!PSUDUZ!PSUPBMG
Begin DoDot:2
+8 MERGE XMY=PSUXMYH
End DoDot:2
+9 IF 'PSUMASF
MERGE XMY=PSUXMYS1
+10 DO ^XMD
End DoDot:1
+11 ;
+12 if NONE
SET PSUTLC=0
+13 SET PSUMSG("M")=PSUMC
+14 SET PSUMSG("L")=PSUTLC
+15 QUIT
NODATA ;Send "No data to report" message
+1 SET ^XTMP(PSUOPSUB,"RECORDS",PSUSNDR,1)="No data to report"
+2 SET NONE=1
SET PSUDIV=PSUSNDR
+3 SET ^XTMP("PSU_"_PSUJOB,"PSUNONE","RX")=""
+4 ;VMP OIFO BAY PINES;ELR;PSU*3.0*31
+5 SET X=PSUDIV
DO DIVNM^PSUOP6
+6 DO XMD
SETCNT ;Set message count and line count
+1 SET PSUMSGT(PSUDIV,"M")=$GET(PSUMSGT(PSUDIV,"M"))+PSUMSG("M")
+2 SET PSUMSGT(PSUDIV,"L")=$GET(PSUMSGT(PSUDIV,"L"))+PSUMSG("L")
+3 SET ^XTMP("PSU_"_PSUJOB,"CONFIRM",PSUDIV,PSUOPTN,"M")=PSUMSGT(PSUDIV,"M")
+4 SET ^XTMP("PSU_"_PSUJOB,"CONFIRM",PSUDIV,PSUOPTN,"L")=PSUMSGT(PSUDIV,"L")
+5 QUIT
