source: FOIAVistA/tag/r/CMOP-PSX/PSXVND.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.2 KB
Line 
1PSXVND ;BIR/WPB,HTW,PWC-File Release Data at the Remote Facility ;10/29/98 2:13 PM
2 ;;2.0;CMOP;**1,2,4,5,14,18,19,15,24,23,27,35,39,36,48,62,58**;11 Apr 97;Build 2
3 ;Reference to ^PSDRUG( supported by DBIA #1983
4 ;Reference to ^PSRX( supported by DBIA #1977
5 ;Reference to ^PS(59 supported by DBIA #1976
6 ;Reference to routine CP^PSOCP supported by DBIA #1974
7 ;Reference to routine EN^PSOHLSN1 supported by DBIA #2385
8 ;Reference to routine EN^RGEQ supported by DBIA #2382
9 ;Reference to routine AUTOREL^PSOBPSUT supported by DBIA #4701
10 ;Called by Taskman to handle release data
11EN H 5 S CNT=1,FROM=XMFROM,ZTREQ="@"
12 S DOMAIN=$S($P(XMFROM,"@",2)'="":"@"_$P(FROM,"@",2),$P(XMFROM,"@",2)="":"",1:""),XMSER="S."_XQSOP,TXMZ=XQMSG
13 S (X,SITE,DA)=$$KSP^XUPARAM("INST"),DIC="4",DIQ(0)="IE",DR=99,DIQ="PSXUTIL" D EN^DIQ1 S HERE=$G(PSXUTIL(4,SITE,99,"I")) K DA,DIC,DIQ(0),DR
14 F X XMREC I $G(XMRG)'="" S TXMRG=XMRG G:$G(XMER)<0 EXIT1 D:$E(XMRG,1,3)["$RX" GET G:$E(XMRG,1,5)["$$END" MAIL D:$E(XMRG,1,4)["$LOT" LOT S:$E(XMRG,1,5)["$$VND" MSNUM=$P(XMRG,"^",3)
15 G EXIT
16GET Q:$G(XMRG)=""!($E(XMRG,1,3)'["$RX")
17 K FACBAT,BAT,NDC,RELDT,STAT,REASON,XFILL,P515A,P515B,%,RR,ALOT,RXP,RXN,FLAG,FILL,RELD,ZSTAT,RTN,CARRIER,PKGID,SHPDT
18 S RX=$P(XMRG,U,2),FACBAT=$P(XMRG,U,3),BAT=$P(FACBAT,"-",2),NDC=$P(XMRG,U,4),RELDT=$P(XMRG,U,5),STAT=$P(XMRG,U,6),REASON=$P($G(XMRG),U,8),XFILL=$P($G(XMRG),U,7)
19 S P515A=$P(XMRG,U,9),P515B=$P(XMRG,U,10),DRG=$P(XMRG,U,12),QTY=$P(XMRG,U,11),CARRIER=$P(XMRG,U,13),PKGID=$P(XMRG,U,14),SHPDT=$P(XMRG,U,15)
20 S FAC=$P(FACBAT,"-",1)
21 Q:FAC'=HERE
22 I '$O(^PSRX("B",RX,0)) S FLAG=2 D TMP Q
23 S XX=0 F S XX=$O(^PSRX("B",RX,XX)) Q:XX'>0 S (RXP,RXN)=XX,FLAG=0 D
24 .I '$G(BAT) Q
25 .I '$D(^PSRX(RXN,0)) S FLAG=2 D TMP Q
26 .L +^PSRX(RXN):DTIME I '$T S FLAG=2 D TMP Q
27 .I XFILL>0,('$D(^PSRX(RXN,1,XFILL,0))) S FLAG=6 D TMP Q
28 .I XFILL>0,($P(^PSRX(RXP,1,XFILL,0),"^",18)'="") S FLAG=1,RLDT=$P(^PSRX(RXP,1,XFILL,0),"^",18) S:STAT=1&(RLDT=RELDT) FLAG=0 D:FLAG=0 TMP1 Q:'$G(FLAG) D:FLAG=1 TMP Q
29 .I XFILL=0,($P(^PSRX(RXP,2),"^",13)'="") S FLAG=1,RLDT=$P(^PSRX(RXP,2),"^",13) S:STAT=1&(RELDT=RLDT) FLAG=0 D:FLAG=0 TMP1 Q:'$G(FLAG) D:FLAG=1 TMP Q
30 .I STAT=2 D
31 ..S RXDRG=$P(^PSRX(RXN,0),"^",6),DFN=$P(^PSRX(RXN,0),"^",2)
32 ..I $G(RXDRG)]"" S CMOPNM=$P($G(^PSDRUG(RXDRG,0)),"^")
33 ..I '$D(^PSDRUG("AQ",RXDRG)) S CMOPYN=1
34 ..I $D(^PSDRUG(RXDRG,"ND")) S CMOPID=$P($G(^PSDRUG(RXDRG,"ND")),"^",10)
35 ..S DIV=$S(XFILL=0:$P(^PSRX(RXN,2),U,9),XFILL>0:$P(^PSRX(RXN,1,XFILL,0),U,9),1:"")
36 ..S ^TMP("PSXCAN1",$J,DIV,DFN,RX)=$G(CMOPNM)_U_$G(CMOPID)_U_$G(QTY)_U_$G(DRG)_U_$G(CMOPYN)_U_REASON_U_$G(XFILL)_U_$G(BAT)
37 ..K CMOPNM,CMOPID,DRG,RXDRG,MATCH,CMOPYN,NDF1,NDF2,P1,P2,PSDDA
38 .I '$D(^PSRX(RXN,4,0)) S FLAG=5 D TMP Q
39 .I '$D(^PSRX(RXN,4,"B",BAT)) S FLAG=4 D TMP Q
40 .I $D(^PSRX(RXN,4,"B",BAT)) S RECD=$O(^PSRX(RXN,4,"B",BAT,"")),FILL=$P($G(^PSRX(RXN,4,RECD,0)),U,3),ZSTAT=$P(^PSRX(RXN,4,RECD,0),U,4)
41 .I ZSTAT=2 S RTN=0 F S RTN=$O(^PSRX(RXN,4,RTN)) Q:RTN'>0 I $P(^PSRX(RXN,4,RTN,0),U,3)=FILL&($P(^PSRX(RXN,4,RTN,0),U,1)'=BAT) S DA(1)=RXN,DA=RTN,DIE="^PSRX("_DA(1)_",4,",DR="3////2;8////FILLED IN TRANSMISSION "_BAT D ^DIE K DA,DR,DIE
42 .I FILL'=XFILL S FLAG=3 D TMP Q
43 .S PSXREF=FILL
44 .Q:FLAG>0
45 .S PSXXMZ=XMZ
46 .D:$G(STAT)=1
47 ..N PSOPAR,PSOSITE,X D NOW^%DTC
48 ..I $G(PSXREF)>0 S PSOSITE=$P(^PSRX(RXP,1,PSXREF,0),"^",9) G:$G(PSOSITE) PAR
49 ..S PSOSITE=$P(^PSRX(RXP,2),"^",9),PSQUIT=0
50 ..I '$G(PSOSITE) S Z1=0 F S Z1=$O(^PS(59,Z1)) Q:Z1=""!(Z1="B") D Q:PSQUIT
51 ...I $D(^PS(59,Z1,"I"))&($P($G(^PS(59,Z1,"I")),"^")'="") Q:$P($G(^PS(59,Z1,"I")),"^")'>X
52 ...S PSOSITE=Z1,PSQUIT=1
53 ..Q:'$G(PSOSITE)
54PAR ..S PSOPAR=$G(^PS(59,PSOSITE,1))
55 ..I $G(PSXREF)>0 S YY=PSXREF
56 ..I '$G(PSOSITE)!('$D(PSOPAR)) Q
57 ..D CP^PSOCP K YY,X
58 .S XMZ=PSXXMZ
59 .I $G(FILL)="" Q
60 .I $G(STAT)=1 D
61 ..I FILL=0 S DA=RXN,DIE="^PSRX(",DR="31///"_RELDT D ^DIE K DIE,DA,DR
62 ..I FILL>0 S DA(1)=RXN,DA=FILL,DIE="^PSRX("_RXN_",1,",DR="17///"_RELDT_";10.1///"_RELDT D ^DIE K DIE,DR,DA
63 ..; I $$VERSION^XPDUTL("OUTPATIENT PHARMACY")<7 S X="RGEQ" X ^%ZOSF("TEST") I D EN^RGEQ("RX",RXN) ;CIRN
64 ..I $$VERSION^XPDUTL("OUTPATIENT PHARMACY")>6 D EN^PSOHLSN1(RXN,"ZD")
65 .S DA(1)=RXN,DA=RECD,DIE="^PSRX("_RXN_",4,"
66 .S DR="3////"_$S(STAT=2:3,STAT=1:1,1:"")_";4////"_NDC_";5////"_$S(STAT=2:RELDT,STAT=1:"",1:"")_";8////"_$S(STAT=2:"^S X=$G(REASON)",STAT=1:"",1:"")_";10////"_$G(CARRIER)_";11////"_$G(PKGID)_";9////"_$G(SHPDT)
67 .D ^DIE K DIE,DA,DR
68 .I $$PATCH^XPDUTL("PSO*7.0*148") D AUTOREL^PSOBPSUT(RXN,FILL,RELDT,NDC,"C",$S(STAT=1:"S",1:"U"),60)
69 I $D(^PSRX(RXN)) L -^PSRX(RXN):0
70TMP1 Q:$G(FLAG)'=0!('$G(BAT))
71 D NOW^%DTC S PSXTM=%
72 S ^TMP($J,"PSXREL",CNT)=RX_"^"_PSXTM_"^"_P515A_"^"_P515B_"^"_XFILL_"^"_HERE
73 S CNT=CNT+1
74 Q
75 ;
76LOT S ALOT=$P(XMRG,"|",2)
77 I $G(ALOT)'="" D
78 .K DD,DO
79 .S:'$D(^PSRX(RXN,5,0)) ^PSRX(RXN,5,0)="^52.0401A^^"
80 .F RR=1:1 Q:$P(ALOT,"\",RR)="" S LOT1=$P(ALOT,"\",RR),LOT=$P(LOT1,"^",1),EXDT=$P(LOT1,"^",2) D
81 ..S DA(1)=RXN,X=LOT,DIC="^PSRX("_RXN_",5,",DIC("DR")="1////"_EXDT_";2////"_XFILL,DIC(0)="Z"
82FF ..D FILE^DICN K DIC("DR"),DIC,DA,LOT,EXDT,DD,DO
83 Q
84TMP S ^TMP($J,"PSXVND",RX)=FLAG_"^"_XFILL_"^"_P515A_"^"_P515B_"^"_HERE_"^"_$S(FLAG=1:RLDT,1:"") Q
85MAIL S XMSUB="CMOP Release Data Acknowledgement",LCNT=1,XMDUZ=.5
86MM D XMZ^XMA2 G:XMZ<1 MM
87 S ^XMB(3.9,XMZ,2,LCNT,0)="$$RTN^"_MSNUM_"^"_HERE,LCNT=LCNT+1
88 F CC=0:0 S CC=$O(^TMP($J,"PSXREL",CC)) Q:CC'>0 D
89 .S ^XMB(3.9,XMZ,2,LCNT,0)="$RX^"_$G(^TMP($J,"PSXREL",CC)),LCNT=LCNT+1
90 S ^XMB(3.9,XMZ,2,LCNT,0)="$$INV"
91 S CC="" F S CC=$O(^TMP($J,"PSXVND",CC)) Q:CC="" S RXN=CC D
92 .S LCNT=LCNT+1 D NOW^%DTC S PSXTM=% ;added for PSX*2*36
93 .S ^XMB(3.9,XMZ,2,LCNT,0)="$RXN"_"^"_RXN_"^"_$G(^TMP($J,"PSXVND",CC))_"^"_PSXTM
94 S ^XMB(3.9,XMZ,2,LCNT+1,0)="$$ENDINV"
95 S ^XMB(3.9,XMZ,2,0)="^3.92A^"_LCNT_U_LCNT_U_DT,XMDUN="CMOP Manager"
96 K XMY S XMY("S.PSXX CMOP SERVER"_DOMAIN)="" D ENT1^XMD
97 ;D ER6^PSXERR Q
98 D:$D(^TMP("PSXCAN1",$J)) CAN^PSXMSGS
99EXIT S XMSER="S.PSXX CMOP SERVER",XMZ=TXMZ D REMSBMSG^XMA1C
100EXIT1 K XMSUB,XMDUZ,XMDUN,XMY,LCNT,XMZ,CC,PSXREL,CNT,Y,X,RR,LOT,LOT1,EXDT,ALOT
101 K RXN,RX,DLAYGO,FACBAT,FILL,FROM,NDC,P514,REASON,RELDT,STAT,XMREC,XMRG
102 K ^TMP($J,"PSXVND"),^TMP($J,"PSXREL"),RLDT,FLAG,TXMRG,PSXXMZ,ZSTAT,PSXTM
103 K XQMSG,XQSOP,XX,ZZZ,%,DAT,DOMAIN,PSXJOB,PSXREF,RECD,RXP,TXMZ,XMZ,XMER
104 K XMFROM,XMSER,BAT,PSXREFL,XFILL,FAC,HERE,P515A,P515B,SITE,MSNUM
105 K DIQ,DIV,QTY,PSXUTIL,SHPDT,Z1,PSQUIT
106 Q
Note: See TracBrowser for help on using the repository browser.