source: FOIAVistA/tag/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUOP4.m@ 628

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