source: FOIAVistA/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUOPMD.m@ 635

PSUOPMD ;BIR/CFL,DAM - PSU PBM Multidose Outpatient Pharmacy create mailman messages ;17 NOV 2004
 ;;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("DATAMD") global
 S (PSUDV,PSUTMP)=""
 F  S PSUDV=$O(^XTMP(PSUOPSUB,"DATAMD",PSUDV)) Q:PSUDV=""  D
 .S PSULCT=0
 .S PSURXIEN=""
 .F  S PSURXIEN=$O(^XTMP(PSUOPSUB,"DATAMD",PSUDV,PSURXIEN)) Q:PSURXIEN=""  D
 ..S PSURCT=0
 ..F  S PSURCT=$O(^XTMP(PSUOPSUB,"DATAMD",PSUDV,PSURXIEN,PSURCT)) Q:PSURCT=""  D
 ...S PSULCT=PSULCT+1
 ...S ^XTMP(PSUOPSUB,"RECMD",PSUDV,PSULCT)=^XTMP(PSUOPSUB,"DATAMD",PSUDV,PSURXIEN,PSURCT,1)
 ...S PSULCT=PSULCT+1
 ...S ^XTMP(PSUOPSUB,"RECMD",PSUDV,PSULCT)=^XTMP(PSUOPSUB,"DATAMD",PSUDV,PSURXIEN,PSURCT,2)
 ...S PSULCT=PSULCT+1
 ...S ^XTMP(PSUOPSUB,"RECMD",PSUDV,PSULCT)=^XTMP(PSUOPSUB,"DATAMD",PSUDV,PSURXIEN,PSURCT,3)
 ...Q:'$D(^XTMP(PSUOPSUB,"DATAMD",PSUDV,PSURXIEN,PSURCT,4))
 ...S PSULCT=PSULCT+1
 ...S ^XTMP(PSUOPSUB,"RECMD",PSUDV,PSULCT)=^XTMP(PSUOPSUB,"DATAMD",PSUDV,PSURXIEN,PSURCT,4)
 ...Q:'$D(^XTMP(PSUOPSUB,"DATAMD",PSUDV,PSURXIEN,PSURCT,5))
 ...S PSULCT=PSULCT+1
 ...S ^XTMP(PSUOPSUB,"RECMD",PSUDV,PSULCT)=^XTMP(PSUOPSUB,"DATAMD",PSUDV,PSURXIEN,PSURCT,5)
 ...Q:'$D(^XTMP(PSUOPSUB,"DATAMD",PSUDV,PSURXIEN,PSURCT,6))
 ...S PSULCT=PSULCT+1
 ...S ^XTMP(PSUOPSUB,"RECMD",PSUDV,PSULCT)=^XTMP(PSUOPSUB,"DATAMD",PSUDV,PSURXIEN,PSURCT,6)
 ;
 ;
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,"RECMD")) 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,"RECMD",PSUDIV)) Q:PSUDIV=""  D
 .S X=PSUDIV,DIC=59,DIC(0)="XM" D ^DIC ;**1
 .S X=+Y,PSUDIVNM=$$VAL^PSUTL(59,X,.01)
 .I PSUMASF!PSUDUZ!PSUPBMG D 
 ..D XMD,SETCNT
 Q
XMD ;
 NEW PSUMAX,PSULC,PSUTMC,PSUTLC,PSUMC,PSUOLD1,PSUOLD2,PSUOLD3
 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,"RECMD",PSUDIV,PSULC)) Q:X=""  D
 .S PSUMLC=PSUMLC+1
 .I PSUMLC>PSUMAX D
 ..I $E(X,1)'="*" S PSUMLC=1
 ..I $E(X,1)="*" D OLD
 .I $L(X)<254 S ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC)=X Q
 .F I=254:-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
 D VARS
 Q
 ;
OLD ; THIS SUBROUTINE STOPS MULTI-LINED MESSAGES FORM SPANNING MAILMAN MSG
 S PSUOLD1=^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-1) I $E(PSUOLD1,1)="*" D
 .S PSUOLD2=^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-2) I $E(PSUOLD2,1)="*" D
 ..S PSUOLD3=^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-3) I $E(PSUOLD3,1)="*" D
 ...S PSUOLD4=^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-4) I $E(PSUOLD4,1)="*" D
 ....S PSUOLD5=^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-5)
 D:$D(PSUOLD5) OLD5 Q
 D:$D(PSUOLD4) OLD4 Q
 D:$D(PSUOLD3) OLD3 Q
 D:$D(PSUOLD2) OLD2 Q
 D:$D(PSUOLD1) OLD1
 Q
 ;
OLD5 ; * IF A RECORD EXCEEDS THE 10,000 CHARACTER 5 TIMES
 S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,1)=PSUOLD5
 K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-5)
 S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,2)=PSUOLD4
 K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-4)
 S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,3)=PSUOLD3
 K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-3)
 S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,4)=PSUOLD2
 K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-2)
 S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,5)=PSUOLD1
 K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-1)
 S PSUMLC=6
 K PSUOLD5,PSUOLD4,PSUOLD3,PSUOLD2,PSUOLD1
 Q
 ;
OLD4 ; * IF A RECORD EXCEEDS THE 10,000 CHARACTER 4 TIMES
 S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,1)=PSUOLD4
 K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-4)
 S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,2)=PSUOLD3
 K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-3)
 S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,3)=PSUOLD2
 K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-2)
 S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,4)=PSUOLD1
 K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-1)
 S PSUMLC=5
 K PSUOLD4,PSUOLD3,PSUOLD2,PSUOLD1
 Q
 ;
OLD3 ;
 S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,1)=PSUOLD3
 K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-3)
 S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,2)=PSUOLD2
 K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-2)
 S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,3)=PSUOLD1
 K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-1)
 S PSUMLC=4
 K PSUOLD3,PSUOLD2,PSUOLD1
 Q
 ;
OLD2 ;
 S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,1)=PSUOLD2
 K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-2)
 S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,2)=PSUOLD1
 K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-1)
 S PSUMLC=3
 K PSUOLD2,PSUOLD1
 Q
 ;
OLD1 ;
 S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,1)=PSUOLD1
 K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-1)
 S PSUMLC=2
 K PSUOLD1
 Q
 ;
 ;   Transmit Messages
VARS ; Setup variables for contents
 F PSUM=1:1:PSUMC D
 .S XMSUB="V. 4.0 PBMOP(MULTIDOSE) "_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
 .I '$G(PSUSMRY) 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,"RECMD",PSUSNDR,1)="No data to report"
 S NONE=1,PSUDIV=PSUSNDR
 ;S ^XTMP("PSU_"_PSUJOB,"PSUNONE","RX")=""
 S X=PSUDIV,DIC=4,DIC(0)="XM" D ^DIC ;**1
 S X=+Y,PSUDIVNM=$$VAL^PSUTL(4,X,.01)
 D XMD
SETCNT ;Set message count and line count
 S PSUMSGT(PSUDIV,"MD","M")=$G(PSUMSGT(PSUDIV,"MD","M"))+PSUMSG("M")
 S PSUMSGT(PSUDIV,"MD","L")=$G(PSUMSGT(PSUDIV,"MD","L"))+PSUMSG("L")
 S ^XTMP("PSU_"_PSUJOB,"CONFIRMD",PSUDIV,PSUOPTN,"M")=PSUMSGT(PSUDIV,"MD","M")
 S ^XTMP("PSU_"_PSUJOB,"CONFIRMD",PSUDIV,PSUOPTN,"L")=PSUMSGT(PSUDIV,"MD","L")
 Q