126 lines
7.0 KiB
Mathematica
126 lines
7.0 KiB
Mathematica
|
PSXVEND ;BIR/WPB,HTW,PWC-Send Release Data to the Remote Facility for Filing ;04/08/97 2:06 PM
|
||
|
|
;;2.0;CMOP;**23,27,35,38**;11 Apr 97
|
||
|
|
;Reference to ^DIC(4.2 supported by DBIA 1966
|
||
|
|
;Reference to ^DD(552.41, supported by DBIA 10155
|
||
|
|
; MODIFIED FOR DOD PILOT
|
||
|
|
QUE S ZTRTN="EN^PSXVEND",ZTDESC="CMOP Return of Release Data",ZTIO="PSX",ZTDTH=$H,ZTSAVE("DUZ")="" D ^%ZTLOAD
|
||
|
|
Q
|
||
|
|
CLOSE S PTR514=$P(^PSX(552.4,AA,0),U,1)
|
||
|
|
Q:$D(^PSX(552.4,"AR",PTR514))!($D(^PSX(552.4,"AC",SS,AA)))!($D(^PSX(552.4,"AX",SS,AA)))
|
||
|
|
S $P(^PSX(552.1,PTR514,0),"^",2)=4,DA=PTR514,DIE="^PSX(552.1,",DR="7///"_PDT_";19////1" D ^DIE K DA,DIE,DR S DA=PTR514,DIK="^PSX(552.1," D IX^DIK K DIK
|
||
|
|
Q
|
||
|
|
TXT I $G(TXT)]"" S LCNT=LCNT+1,^XMB(3.9,XMZ,2,LCNT,0)=TXT K TXT Q
|
||
|
|
;Called by Taskman to send Release data to Remote
|
||
|
|
EN S ZTREQ="@"
|
||
|
|
S ZX=0 F S ZX=$O(^PSX(552.4,"AC",ZX)) Q:ZX'>0 S SITE=ZX D EN1
|
||
|
|
G EXIT1
|
||
|
|
; DOD MODS NEXT LINE
|
||
|
|
EN1 S PSX552=$O(^PSX(552,"D",ZX,"")) I $G(PSX552)>0 S PSXDOD=$P($G(^PSX(552,PSX552,0)),"^",5) D ^PSXDODQY Q ;****DOD
|
||
|
|
S LCNT=0,XMSUB="Vendor release data",XMDUZ=.5
|
||
|
|
XMZ D XMZ^XMA2
|
||
|
|
I XMZ'>0 G XMZ
|
||
|
|
D NOW^%DTC
|
||
|
|
S TXT="$$VND^"_%_"^"_XMZ D TXT
|
||
|
|
F AA=0:0 S AA=$O(^PSX(552.4,"AC",ZX,AA)) Q:AA'>0 S BB=0 F S BB=$O(^PSX(552.4,"AC",ZX,AA,BB)) Q:BB'>0 D
|
||
|
|
.S FACBAT=$P(^PSX(552.1,+$P(^PSX(552.4,AA,0),"^"),0),"^"),RXN=$P($G(^PSX(552.4,AA,1,BB,0)),U,1),FAC=$P(FACBAT,"-",1),DRG=$P(^PSX(552.4,AA,1,BB,0),"^",4),QTY=$P(^PSX(552.4,AA,1,BB,0),"^",13)
|
||
|
|
.S NDC=$P($G(^PSX(552.4,AA,1,BB,0)),U,5),COMPDT=$P($G(^(0)),U,9),STAT=$P($G(^(0)),U,2),FILL=$P($G(^(0)),U,12) S:STAT=2 REASON=$P($G(^(0)),U,3)
|
||
|
|
.S LOT="|" F CC=0:0 S CC=$O(^PSX(552.4,AA,1,BB,1,CC)) Q:CC'>0 S LOT=LOT_$G(^PSX(552.4,AA,1,BB,1,CC,0))_"\"
|
||
|
|
.S SHPDT=$P($G(^PSX(552.4,AA,1,BB,2)),"^",4),CARRIER=$P($G(^PSX(552.4,AA,1,BB,2)),"^",5),PKGID=$P($G(^(2)),"^",6)
|
||
|
|
.L +^PSX(552.4,AA,1,BB):600 Q:'$T
|
||
|
|
.S DA=BB,DA(1)=AA,DIE="^PSX(552.4,"_AA_",1,",DR="9////2;15////"_XMZ D ^DIE K DA,DR,DIE
|
||
|
|
.L -^PSX(552.4,AA,1,BB)
|
||
|
|
.S TXT="$RX^"_RXN_U_FACBAT_U_$G(NDC)_U_COMPDT_U_STAT_U_FILL_U_$G(REASON)_U_AA_U_BB_U_$G(QTY)_U_$G(DRG)_U_CARRIER_U_PKGID_U_$G(SHPDT),TRX=$G(TRX)+1 D TXT
|
||
|
|
.I $P(LOT,"|",2)'="" S TXT="$LOT^"_$G(LOT) D TXT
|
||
|
|
.K NDC,COMPDT,STAT,REASON,LOT,RXN,FACBAT,CARRIER,PKGID,SHPDT
|
||
|
|
S TXT="$$ENDVND" D TXT
|
||
|
|
S ^XMB(3.9,XMZ,2,0)="^3.92A^"_LCNT_U_LCNT_U_DT,XMDUN="CMOP Manager"
|
||
|
|
;S X=SITE,DIC="4",DIC(0)="XMZO" S:$D(PSX(552,"D",X)) X=$E(X,2,99) D ^DIC S PTR=+Y,XPTR=$O(^PSX(552,"B",PTR,"")),FACDOM=$P($G(^PSX(552,XPTR,0)),U,4) ;****DOD L1
|
||
|
|
S X=SITE,AGNCY="VASTANUM" S:$D(PSX(552,"D",X)) X=$E(X,2,99),AGNCY="DMIS" S PTR=$$IEN^XUMF(4,AGNCY,X),XPTR=$O(^PSX(552,"B",PTR,"")),FACDOM=$P($G(^PSX(552,XPTR,0)),U,4) ;****DOD L1
|
||
|
|
S DOMAIN="@"_$$GET1^DIQ(4.2,FACDOM,.01)
|
||
|
|
K XMY S XMY("S.PSXX CMOP SERVER"_DOMAIN)=""
|
||
|
|
;K XMY S XMY(DUZ)=""
|
||
|
|
S XMDUZ=.5 D ENT1^XMD
|
||
|
|
D NOW^%DTC
|
||
|
|
S:'$D(^PSX(554,1,3,0)) ^PSX(554,1,3,0)="^554.03DA^^"
|
||
|
|
K DD,DO
|
||
|
|
S DA(1)=1,DIC="^PSX(554,"_DA(1)_",3,",DIC(0)="Z",DIC("DR")="1////"_XMZ_";2////"_FAC_";5////"_TRX,X=% D FILE^DICN K DIC,DA,DIC("DR"),DIC(0),X,TRX
|
||
|
|
Q
|
||
|
|
RTN ;called by the server to file the release data acknowledgement in 552.4
|
||
|
|
S FROM=XMFROM,XMSER="S."_XQSOP,TXMZ=XQMSG,ZTREQ="@"
|
||
|
|
K ^TMP($J,"PSXINV")
|
||
|
|
F X XMREC G:$G(XMER)<0 EXIT D:$E(XMRG,1,5)["$$RTN" UPFL D:$E(XMRG,1,3)["$RX" FILE G:$E(XMRG,1,5)["$$INV" INV G:$E(XMRG,1,5)["$$END" END
|
||
|
|
Q
|
||
|
|
UPFL D NOW^%DTC S ACKTM=%
|
||
|
|
S MSGNUM=$P(XMRG,"^",2)
|
||
|
|
S RFAC=$P(XMRG,"^",3)
|
||
|
|
DOD ; entry from PSXDODAK to update 554 message
|
||
|
|
UPFL1 Q:$G(MSGNUM)=""
|
||
|
|
Q:'$D(^PSX(554,"AC",MSGNUM)) S (XNUM,RNUM)=$O(^PSX(554,"AC",MSGNUM,"")),DA(1)=1,DA=RNUM,DIE="^PSX(554,"_DA(1)_",3,",DR="3////"_TXMZ_";4////"_ACKTM D ^DIE K DA,DR,DIE,%
|
||
|
|
Q
|
||
|
|
FILE Q:$G(XMRG)=""
|
||
|
|
S RXNUM=$P(XMRG,"^",2),PDT=$P(XMRG,"^",3),AA=$P(XMRG,"^",4),BB=$P(XMRG,"^",5),SS=$P(XMRG,"^",7)
|
||
|
|
DODRX ; entry point from PSXDODAK to file RX release filed 'ack'
|
||
|
|
S RN=$P($G(^PSX(552.4,AA,1,BB,0)),U,1),RXSTAT=$P(^PSX(552.4,AA,1,BB,0),"^",10)
|
||
|
|
;I RXSTAT=3 S ^TMP($J,"PSXINV",RXNUM)="" Q
|
||
|
|
Q:'$D(^PSX(552.4,"AX",SS,AA,BB))
|
||
|
|
I $G(MSGNUM)="" S MSGNUM=$P(^PSX(552.4,AA,1,BB,2),"^",3) D UPFL1
|
||
|
|
L +^PSX(552.4,AA,1,BB):600 Q:'$T
|
||
|
|
I RN=RXNUM S DA(1)=AA,DA=BB,DIE="^PSX(552.4,"_AA_",1,",DR="7///"_PDT_";9////3;15////@" D ^DIE K DIE,DA,DR
|
||
|
|
L -^PSX(552.4,AA,1,BB)
|
||
|
|
D CLOSE
|
||
|
|
K RXNUM,PDT,AA,BB,SS,RXSTAT,RX
|
||
|
|
Q
|
||
|
|
;Called by Taskman to file Vendor Release data on DHCP host
|
||
|
|
INV S FROM=XMFROM,XMSER="S."_XQSOP,TXMZ=XQMSG
|
||
|
|
F X XMREC G:$G(XMER)<0 EXIT D:$E(XMRG,1,4)["$RXN" FILEINV G:$E(XMRG,1,5)["$$END" END
|
||
|
|
Q
|
||
|
|
FILEINV Q:$G(XMRG)=""
|
||
|
|
S RXN=$P(XMRG,"^",2),STAT=$P(XMRG,"^",3),FILL=$P(XMRG,"^",4),PDT=$P(XMRG,"^",8),AA=$P(XMRG,"^",5),BB=$P(XMRG,"^",6),SS=$P(XMRG,"^",7)
|
||
|
|
DODINV ; entry point from PSXDODAK to file a facility release filed 'nak'
|
||
|
|
S RN=$P($G(^PSX(552.4,AA,1,BB,0)),U,1),RXSTAT=$P(^PSX(552.4,AA,1,BB,0),"^",10)
|
||
|
|
Q:'$D(^PSX(552.4,"AX",SS,AA,BB))
|
||
|
|
S P521=$P(^PSX(552.4,AA,0),"^"),ZBAT=$P(^PSX(552.1,P521,0),"^")
|
||
|
|
S ^TMP("PSXERR",$J,ZBAT,RXN)=STAT_U_FILL_U_""_U_SS_U_AA
|
||
|
|
K P521,ZBAT
|
||
|
|
L +^PSX(552.4,AA,1,BB):600 Q:'$T
|
||
|
|
I RN=RXN S DA(1)=AA,DA=BB,DIE="^PSX(552.4,"_AA_",1,",DR="9////4;7///"_PDT_";14////"_STAT_";15////@" D ^DIE K DIE,DA,DR
|
||
|
|
L -^PSX(552.4,AA,1,BB)
|
||
|
|
D CLOSE
|
||
|
|
K RXNUM,PDT,AA,BB,SS,RXSTAT,RX
|
||
|
|
Q
|
||
|
|
END D NOW^%DTC
|
||
|
|
I $G(XNUM) S DA(1)=1,DA=XNUM,DIE="^PSX(554,"_DA(1)_",3,",DR="1////@;6////"_% D ^DIE K DA,DIE,DR
|
||
|
|
EXIT S XMZ=TXMZ D REMSBMSG^XMA1C
|
||
|
|
I $D(^TMP($J,"PSXINV")) D INVREL^PSXMSGS
|
||
|
|
D REMERR
|
||
|
|
EXIT1 K XMER,XMRG,XMZ,PDT,RXNUM,%,FROM,LCNT,XMDUN,XMDUZ,XMFROM,XMREC,XMSUB,XMY,NDC,COMPDT,STAT,REASON,LOT,RXN,FACBAT,AA,BB,CC,ZZ,XX,YY,TXT,CNT,DOMAIN,RN,SS,ZX
|
||
|
|
K FACDOM,FILL,PTR,SITE,TXMZ,XMSER,XPTR,XQMSG,XQSOP,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK,FAC,MSGNUM,PRT514,XNUM,PTR514,ACKTM,QTY,RNUM,DRG,RFAC
|
||
|
|
S ZTREQ="@"
|
||
|
|
Q
|
||
|
|
Q
|
||
|
|
REMERR ; Builds msg for remote error conditions
|
||
|
|
Q:'$D(^TMP("PSXERR",$J))
|
||
|
|
S XL=" "
|
||
|
|
S XMSUB=RFAC_" CMOP Remote Error Condition Notice",XMDUZ=.5
|
||
|
|
D XMZ^XMA2 Q:XMZ'>0
|
||
|
|
; ^TMP("PSXERR",$J,TRANS#,RX#)=RX STATUS^FILL #^NOT USED^SITE#^P552.4
|
||
|
|
S ^XMB(3.9,XMZ,2,2,0)=""
|
||
|
|
S ^XMB(3.9,XMZ,2,3,0)=" TRANS # RX # FILL # REMOTE ERROR",XLCT=4
|
||
|
|
S ZBAT="" F S ZBAT=$O(^TMP("PSXERR",$J,ZBAT)) Q:$G(ZBAT)']"" S XX="" F S XX=$O(^TMP("PSXERR",$J,ZBAT,XX)) Q:$G(XX)']"" D
|
||
|
|
.S ZBAT1=ZBAT_$E(XL,1,(10-$L(ZBAT)))
|
||
|
|
.S XX1=XX_$E(XL,1,(15-$L(XX)))
|
||
|
|
.S DATA=$G(^TMP("PSXERR",$J,ZBAT,XX))
|
||
|
|
.S Y=+$P(DATA,"^"),ERR=$$EXTERNAL^DILFD(552.41,14,"",Y) K Y
|
||
|
|
.S FILL=$P(DATA,"^",2),FILL=FILL_$E(XL,1,(8-$L(FILL)))
|
||
|
|
.N Y S Y=$P(DATA,"^",3) X ^DD("DD") S PDT=Y K Y
|
||
|
|
START . ;
|
||
|
|
. ;I '$D(FAC) S F2=+$P(^PSX(552.1,+$P(^PSX(552.4,$P(DATA,"^",5),0),"^"),0),"^"),X=F2,DIC="4",DIC(0)="XZMO" S:$D(^PSX(552,"D",X)) X=$E(X,2,99) D ^DIC S F3=+Y,FAC=$P(Y,"^",2) K DIC,X,Y ;****DOD L1
|
||
|
|
.I '$D(FAC) S F2=+$P(^PSX(552.1,+$P(^PSX(552.4,$P(DATA,"^",5),0),"^"),0),"^"),X=F2,AGNCY="VASTANUM" S:$D(^PSX(552,"D",X)) X=$E(X,2,99),AGNCY="DMIS" S F3=$$IEN^XUMF(4,AGNCY,X),FAC=$$NAME^XUAF4(F3) K AGNCY,X,Y ;****DOD L1
|
||
|
|
.S ^XMB(3.9,XMZ,2,XLCT,0)=ZBAT1_XX1_FILL_PDT_ERR,XLCT=XLCT+1
|
||
|
|
.K DATA,P1,P2,ERR,FILL,PDT,PDT1,PDT2,XX1,F2,F3,ZBAT1
|
||
|
|
S ^XMB(3.9,XMZ,2,1,0)="The following prescriptions could not be filed at "_$G(FAC)_" due to listed error conditions."
|
||
|
|
S ^XMB(3.9,XMZ,2,0)="^3.92A^"_XLCT_U_XLCT_U_DT,XMDUN="CMOP Manager"
|
||
|
|
K XMY D GRP^PSXNOTE D ENT1^XMD
|
||
|
|
K FAC,XX,XL,XLCT,ZBAT,RFAC
|
||
|
|
Q
|