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