| 1 | PSORELDT ;BIR/PWC-HL7 V.2.4 EXTERNAL INTERFACE RELEASE DATE/TIME ;01/05/04 09:45
|
|---|
| 2 | ;;7.0;OUTPATIENT PHARMACY;**156**;DEC 1997
|
|---|
| 3 | ;PS(51.2 supp. by DBIA 2226
|
|---|
| 4 | ;GETAPP^HLCS2 supported by DBIA 2887
|
|---|
| 5 | ;INIT^HLFNC2 supported by DBIA 2161
|
|---|
| 6 | ;GENERATE^HLMA supported by DBIA 2164
|
|---|
| 7 | ;SETUP^XQALERT supported by DBIA 10081
|
|---|
| 8 | ;XUSEC("PSOINTERFACE" supported by DBIA 10076
|
|---|
| 9 | ;ORD(101 supported by DBIA 872
|
|---|
| 10 | ;
|
|---|
| 11 | INIT ;initialize variables and build outgoing message
|
|---|
| 12 | N DFLAG,HLRESLT,HLP,PSLINK,PSOHLSER,PSOHLCL,PSOHLINX
|
|---|
| 13 | S PSOHLINX=$$GETAPP^HLCS2("PSO EXT SERVER") I $P($G(PSOHLINX),"^",2)="i" Q
|
|---|
| 14 | K ^TMP("PSO",$J)
|
|---|
| 15 | S PIEN=$O(^ORD(101,"B","PSO EXT SERVER",0)) G:'PIEN EXIT
|
|---|
| 16 | S PSI=1,HLPDT=DT D INIT^HLFNC2(PIEN,.HL1) I $G(HL1) G EXIT
|
|---|
| 17 | S FS=HL1("FS"),HL1("ECH")="~^\&",HLECH=HL1("ECH"),CS=$E(HL1("ECH")),RS=$E(HL1("ECH"),2),EC=$E(HL1("ECH"),3),SCS=$E(HL1("ECH"),4)
|
|---|
| 18 | F II=0:0 S II=$O(^UTILITY($J,"PSOHL",II)) Q:'II D
|
|---|
| 19 | .S ODR=$G(^UTILITY($J,"PSOHL",II)),IRXN=$P(ODR,"^"),IDGN=$P(^PSRX(IRXN,0),"^",2),PSODTM=$P(ODR,"^",3)
|
|---|
| 20 | .I '$G(PSODTM) D NOW^%DTC S DTME=%
|
|---|
| 21 | .I $G(PSODTM) S DTME=PSODTM
|
|---|
| 22 | .S PRSN=$P(ODR,"^",4),RPRT=$P(ODR,"^",5),DIV=$G(PSOSITE),FPN=$P(ODR,"^",9)
|
|---|
| 23 | .S DFN=$P(^PSRX(IRXN,0),"^",2),STPMTR=$P($G(^PS(59,DIV,1)),"^",30)
|
|---|
| 24 | .K DIC,DA,DD,DO
|
|---|
| 25 | .S DIC="^PS(52.51,",X=IRXN,DIC(0)=""
|
|---|
| 26 | .S DIC("DR")="2////"_DFN_";3////"_DTME_";4////"_PRSN_";5////"_RPRT_";6////"_STPMTR_";9////"_FPN_";15////"_DIV_";13////"_"BUILDING MESSAGE"_";14////1"
|
|---|
| 27 | .D FILE^DICN K DD,DO,Y,DIC
|
|---|
| 28 | .D ^PSORELD1
|
|---|
| 29 | K ^TMP("HLS",$J)
|
|---|
| 30 | M ^TMP("HLS",$J)=^TMP("PSO",$J)
|
|---|
| 31 | S HLP("CONTPTR")="",HLP("SUBSCRIBER")="^^^^"_$P(^PS(59,PSOSITE,0),"^",6)_"~"_$P(^PS(59,PSOSITE,0),"^")_"~DNS"
|
|---|
| 32 | D GENERATE^HLMA(PIEN,"GM",1,.HLRESLT,"",.HLP)
|
|---|
| 33 | K HLL S HLMID=$P($G(HLRESLT),"^"),HLERR=$P($G(HLRESLT),"^",2)
|
|---|
| 34 | I '$G(HLMID) S XQAMSG="Error transmitting "_$P(^DPT(DFN,0),"^")_" order to external interface" D ALERT G EXIT
|
|---|
| 35 | I $G(HLMID),$P($G(HLERR),"^")'="" S XQAMSG="Error transmitting batch "_HLMID_" to the external interface",MESS="TRANSMISSION FAILED",STA=3 D UFILE,ALERT G EXIT
|
|---|
| 36 | I $G(HLMID),$P($G(HLERR),"^")="" S MESS="MESSAGE TRANSMITTED",STA=1 D UFILE G EXIT
|
|---|
| 37 | UFILE S II="" F S II=$O(^TMP("PSOMID",$J,II)) Q:II="" S III=$G(^(II)) D
|
|---|
| 38 | .S PRX=$P(III,"^"),PFP=$P(III,"^",2),PFPN=$P(III,"^",3)
|
|---|
| 39 | .Q:'$D(^PS(52.51,"B",PRX))
|
|---|
| 40 | .S JJ="" F S JJ=$O(^PS(52.51,"B",PRX,JJ)) Q:JJ="" D
|
|---|
| 41 | ..I $P(^PS(52.51,JJ,0),"^")=PRX,$P(^(0),"^",8)=PFP,$P(^(0),"^",9)=PFPN S DA=JJ,DIE="^PS(52.51,",DR="10////"_HLMID_";13////"_MESS_";14////"_STA_"" D ^DIE
|
|---|
| 42 | Q
|
|---|
| 43 | ;
|
|---|
| 44 | EXIT S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 45 | K ^TMP("PSOMID",$J),MESS,PSODTM,STA,HLMID,PRX,PFP,PFPN,CS,CPY,DAW,DIN,DRI,EC,FP,FPN,FS,ING,IRXN,IDGN,II,JJ,ODR,PSI,RS,SCS,SDI,%
|
|---|
| 46 | K DA,DIE,DIV,DR,DTME,HL1,HLERR,HLPDT,XXX,^TMP("PSO",$J),DFN,PAS,STPMTR,X,III,PIEN,PRSN,RPRT
|
|---|
| 47 | K ^TMP("HLS",$J) ;keep around for testing
|
|---|
| 48 | Q
|
|---|
| 49 | ;
|
|---|
| 50 | ERRMSG S EMSG=""
|
|---|
| 51 | F AA=1:1 X HLNEXT Q:HLQUIT'>0 S EMSG=EMSG_"&&"_HLNODE
|
|---|
| 52 | S ^TMP("PSO2",$J)=EMSG
|
|---|
| 53 | Q
|
|---|
| 54 | ALERT ;turn off transmission and send alert to key holders
|
|---|
| 55 | S:$G(PSOSITE) $P(^PS(59,PSOSITE,0),"^",30)=0
|
|---|
| 56 | K XQA,XQAOPT,XQAROU,XQAID,XQADATA,XQAFLAG
|
|---|
| 57 | F UID=0:0 S UID=$O(^XUSEC("PSOINTERFACE",UID)) Q:'UID S XQA(UID)=""
|
|---|
| 58 | D SETUP^XQALERT
|
|---|
| 59 | Q
|
|---|
