source: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOHLSG.m@ 1365

Last change on this file since 1365 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 6.0 KB
Line 
1PSOHLSG ;BIR/LC,PWC-HL7 EXTERNAL INTERFACE ;03/01/96 09:45
2 ;;7.0;OUTPATIENT PHARMACY;**26,70,139,156**;DEC 1997
3 ;External reference to GETAPP^HLCS2 supported by DBIA 2887
4 ;External reference to INIT^HLFNC2 supported by DBIA 2161
5 ;External reference to GENERATE^HLMA supported by DBIA 2164
6 ;External reference to SETUP^XQALERT supported by DBIA 10081
7 ;External reference to ^XUSEC("PSOINTERFACE" supported by DBIA 10076
8 ;External reference to ^ORD(101 supported by DBIA 872
9 ;
10INIT ;initialize variables and build outgoing message
11 Q:'$D(^UTILITY($J,"PSOHL"))
12 S PSODISP=$$GET1^DIQ(59,PSOSITE_",",105,"I") ;flag to determine if site is running HL7 V.2.4 dispensing systems
13 I PSODISP="2.4" G ^PSOHLDS ;branch off for V.2.4 dispensing machines
14 N DFLAG,HLRESLT,HLP,PSLINK,PSOHLINX
15 S PSOHLINX=$$GETAPP^HLCS2("PSO HLSERVER1") Q:$P($G(PSOHLINX),"^",2)="i"
16 K ^TMP("PSO",$J)
17 S PIEN=$O(^ORD(101,"B","PSO HLSERVER1",0)) G:'PIEN EXIT
18 S PSI=1,HLPDT=DT D INIT^HLFNC2(PIEN,.HL1) I $G(HL1) G EXIT
19 S FS=HL1("FS"),HL1("ECH")="^~\&",CS=$E(HL1("ECH")),RS=$E(HL1("ECH"),2),EC=$E(HL1("ECH"),3),SCS=$E(HL1("ECH"),4)
20 I '$G(PSODTM) D NOW^%DTC S DTME=%
21 I $G(PSODTM) S DTME=PSODTM
22 F II=0:0 S II=$O(^UTILITY($J,"PSOHL",II)) Q:'II S ODR=^UTILITY($J,"PSOHL",II) D
23 .S IRXN=$P(ODR,"^"),IDGN=$P(ODR,"^",2),FP=$P(ODR,"^",3),FPN=$P(ODR,"^",4),DAW=$P(ODR,"^",5),DIN=$P(ODR,"^",6)
24 .S ^TMP("PSOMID",$J,II)=IRXN_"^"_FP_"^"_FPN I DIN=1 D
25 ..F JJ=0:0 S JJ=$O(^UTILITY($J,"PSOHL",II,JJ)) Q:'JJ S ING(JJ)=^UTILITY($J,"PSOHL",II,JJ)
26 .S SDI=$P(ODR,"^",7) I SDI=1 S DRI=^UTILITY($J,"PSOHL",II,"DRI")
27 .S CPY=$P(ODR,"^",8),RPRT=$P(ODR,"^",9),PRSN=$P(ODR,"^",10),DIV=$G(PSOSITE),DFN=$P(^PSRX(IRXN,0),"^",2),STPMTR=$P($G(^PS(59,DIV,1)),"^",30)
28 .I $G(STPMTR)>1&($P($G(^PSRX(IRXN,"STA")),"^")=5) D
29 ..N PSOHLSPZ,PSOHLNDA S PSOHLSPZ=$O(^PS(52.5,"B",IRXN,0)),PSOHLNDA=""
30 ..I PSOHLSPZ S PSOHLNDA=$G(^PS(52.5,PSOHLSPZ,0))
31 ..I $G(RXPR(IRXN)),+$G(RXPR(IRXN))'=$P(PSOHLNDA,"^",5) Q
32 ..I '$G(RXRP(IRXN)),'$G(RXPR(IRXN)),$D(RXFL(IRXN)),$P(PSOHLNDA,"^",13)'="",$P($G(RXFL(IRXN)),"^")'=$P(PSOHLNDA,"^",13) Q
33 ..D SUS^PSOLBL4(IRXN,FP,FPN,RPRT)
34 .K DIC,DA,DD,DO
35 .S DIC="^PS(52.51,",X=IRXN,DIC(0)=""
36 .S DIC("DR")="2////"_DFN_";3////"_DTME_";4////"_PRSN_";5////"_RPRT_";6////"_STPMTR_";8////"_FP_";9////"_FPN_";15////"_DIV_";13////"_"BUILDING MESSAGE"_";14////1"
37 .D FILE^DICN K DD,DO,Y,DIC
38 .D START^PSOHLSG1
39 K ^TMP("HLS",$J)
40 M ^TMP("HLS",$J)=^TMP("PSO",$J)
41 S PSLINK=$O(^UTILITY($J,"PSOHL",0))
42 S HLL("LINKS",1)="PSO HLCLIENT1^"_$P($G(^UTILITY($J,"PSOHL",PSLINK)),"^",12)
43 S HLP("CONTPTR")="" D GENERATE^HLMA(PIEN,"GM",1,.HLRESLT,"",.HLP)
44 K HLL S HLMID=$P($G(HLRESLT),"^"),HLERR=$P($G(HLRESLT),"^",2)
45 I '$G(HLMID) S XQAMSG="Error transmitting "_$P(^DPT(DFN,0),"^")_" order to external interface" D ALERT G EXIT
46 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
47 I $G(HLMID),$P($G(HLERR),"^")="" S MESS="MESSAGE TRANSMITTED",STA=1 D UFILE G EXIT
48UFILE S II="" F S II=$O(^TMP("PSOMID",$J,II)) Q:II="" S III=$G(^(II)) D
49 .S PRX=$P(III,"^"),PFP=$P(III,"^",2),PFPN=$P(III,"^",3)
50 .Q:'$D(^PS(52.51,"B",PRX))
51 .S JJ="" F S JJ=$O(^PS(52.51,"B",PRX,JJ)) Q:JJ="" D
52 ..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
53 Q
54 ;
55EXIT S:$D(ZTQUEUED) ZTREQ="@"
56 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,%
57 K DA,DIE,DIV,DR,DTME,HL1,HLERR,HLPDT,XXX,^TMP("PSO",$J),DFN,PAS,STPMTR,X,III,PIEN,PRSN,RPRT
58 K ^TMP("HLS",$J)
59 Q
60 ;
61ERRMSG S EMSG=""
62 F AA=1:1 X HLNEXT Q:HLQUIT'>0 S EMSG=EMSG_"&&"_HLNODE
63 S ^TMP("PSO2",$J)=EMSG
64 Q
65ACK ;process MSA received from the dispense machine (client)
66 ;
67 S:'$D(HL("APAT")) HL("APAT")="AL"
68 S AACK=HL("APAT"),DTM=HL("DTM"),ETN=HL("ETN"),CMID=HL("MID")
69 S MTN=HL("MTN"),RAN=HL("RAN"),SAN=HL("SAN"),VER=HL("VER")
70 S EID=HL("EID"),EIDS=HL("EIDS"),FS=HL("FS")
71 I $G(VER)'="2.2" G EXT
72 S MSA=""
73 F AA=1:1 X HLNEXT Q:HLQUIT'>0 S MSA=MSA_"&&"_HLNODE
74 ;
75 S ^TMP("PSO1",$J,CMID)=CMID_"^"_AACK_"^"_DTM_"^"_ETN_"^"_MTN_"^"_RAN_"^"_SAN_"^"_VER_"^"_EID_"^"_EIDS_"^"_MSA
76 S MSA1=$P(^TMP("PSO1",$J,CMID),"&&",3),MSACDE=$P(MSA1,FS,2),SMID=$P(MSA1,FS,3) S:$P(MSA1,FS,4) ERRMSG=$P(MSA1,FS,4)
77 ;
78 S (DIV1,SP1,SP2)="" F S DIV1=$O(^PS(52.51,"AM",SMID,DIV1)) Q:'DIV1 F S SP1=$O(^PS(52.51,"AM",SMID,DIV1,SP1)) Q:'SP1!(SP1=2) S SP2=$P($G(^PS(52.51,SP1,0)),"^",6)
79 I '$D(MSACDE) G EXT
80 I $G(MSACDE)="AA" D ACK1
81 I $G(MSACDE)="AE"!$G(MSACDE)="AR" D ACK2
82 ;the following can be used if site require ACKing the ACK
83 ;S HLARYTYP="GM",HLFORMAT=1,HLMTIENS="",HLP("CONTPTR")=""
84 ;S HLEID=EID,HLMTIENS="",HLEIDS=EIDS,HLARYTYP="GM",HLFORMAT=1,HLMTIENA=""
85 ;D GENACK^HLMA1(HLEID,HLMTIENS,HLEIDS,HLARYTYP,HLFORMAT,.HLRESLTA,HLMTIENA,.HLP)
86 ;
87EXT ;K ALL VARIABLES AND QUIT
88 K ^TMP("PSO1",$J),AACK,DTM,ETN,CMID,MTN,RAN,SAN,VER,EID,EIDS,FS,MSA,AA,RPT
89 K MSA1,MSACDE,SMID,ERRMSG,DIV1,SP1,SP2,HL,UID,FLL,FLLN,IRX,FLD12,FLD13
90 K DIE,EMSG,HLQUIT,HLNEXT,HLNODE
91 Q
92 ;
93ACK1 ;
94 S FLD13="PROCESSED" D FACK1
95 Q
96 ;
97ACK2 S XQAMSG="Error processing batch "_SMID_". Interface has been shutdown.",FLD13="PROCESS FAILED" S:$G(ERRMSG) FLD12=ERRMSG
98 D FACK2,ALERT
99 Q
100 ;
101ALERT ;turn off transmission and send alert to key holders
102 S:$G(PSOSITE) $P(^PS(59,PSOSITE,0),"^",30)=0
103 K XQA,XQAOPT,XQAROU,XQAID,XQADATA,XQAFLAG
104 F UID=0:0 S UID=$O(^XUSEC("PSOINTERFACE",UID)) Q:'UID S XQA(UID)=""
105 D SETUP^XQALERT
106 Q
107FACK1 ;
108 S (DIV1,SP1)="" F S DIV1=$O(^PS(52.51,"AM",SMID,DIV1)) Q:'DIV1 F S SP1=$O(^PS(52.51,"AM",SMID,DIV1,SP1)) Q:'SP1 S DA=SP1 D
109 .S DIE="^PS(52.51,",DR="7////"_SAN_";11////"_CMID_";13////"_FLD13_";14////2" D ^DIE
110 .I $G(SP2)>1 S IRX=$P(^PS(52.51,SP1,0),"^"),FLL=$P(^(0),"^",8),FLLN=$P(^(0),"^",9),RPT=$P(^(0),"^",5) D LAB^PSOLBL4(IRX,FLL,FLLN,RPT)
111 Q
112 ;
113FACK2 ;
114 S (DIV1,SP1)="" F S DIV1=$O(^PS(52.51,"AM",SMID,DIV1)) Q:'DIV1 F S SP1=$O(^PS(52.51,"AM",SMID,DIV1,SP1)) Q:'SP1 S DA=SP1 D
115 .S DIE="^PS(52.51,",DR="7////"_SAN_";11////"_CMID_";12////"_FLD12_";13////"_FLD13_";14////3" D ^DIE
116 Q
Note: See TracBrowser for help on using the repository browser.