Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOHLDS

PSOHLDS.m

Go to the documentation of this file.
  1. PSOHLDS ;BIR/PWC-HL7 V.2.4 AUTOMATED DISPENSE INTERFACE ;03/01/96 09:45
  1. ;;7.0;OUTPATIENT PHARMACY;**156,312,354,531,603,643**;DEC 1997;Build 35
  1. ;External reference to GETAPP^HLCS2 supported by DBIA 2887
  1. ;External reference to INIT^HLFNC2 supported by DBIA 2161
  1. ;External reference to GENERATE^HLMA supported by DBIA 2164
  1. ;External reference to SETUP^XQALERT supported by DBIA 10081
  1. ;External reference to ^XUSEC("PSOINTERFACE" supported by DBIA 10076
  1. ;External reference to ^ORD(101 supported by DBIA 872
  1. ;External reference to ^PSDRUG supported by DBIA 221
  1. ;
  1. INIT ;initialize variables and build outgoing message
  1. N DFLAG,HLRESLT,HLP,PSLINK,PSOHLSER,PSOHLCL,PSOHLINX,DDNS,PSOENH,PSOADD,ADDCAT,PSOMES,OPADD,OPNAM,PSOFNHL7
  1. S PSOHLINX=$$GETAPP^HLCS2("PSO EXT SERVER") Q:$P($G(PSOHLINX),"^",2)="i"
  1. K ^TMP("PSO",$J),^TMP("PSOADD",$J)
  1. S PIEN=$O(^ORD(101,"B","PSO EXT SERVER",0)) G:'PIEN EXIT
  1. S PSI=1,HLPDT=DT D INIT^HLFNC2(PIEN,.HL1) I $G(HL1) G EXIT
  1. S FS=HL1("FS"),HL1("ECH")="~^\&",HLECH=HL1("ECH")
  1. S CS=$E(HL1("ECH")),RS=$E(HL1("ECH"),2),EC=$E(HL1("ECH"),3),SCS=$E(HL1("ECH"),4)
  1. I '$G(PSODTM) D NOW^%DTC S DTME=%
  1. I $G(PSODTM) S DTME=PSODTM
  1. S DDNS=$$GET1^DIQ(59,PSOSITE_",",2006)
  1. S PSOENH=0 D GETDEV,ALLADD
  1. F II=0:0 S II=$O(^UTILITY($J,"PSOHL",II)) Q:'II S ODR=^UTILITY($J,"PSOHL",II) D
  1. .S IRXN=$P(ODR,"^"),IDGN=$P(ODR,"^",2),FP=$P(ODR,"^",3),FPN=$P(ODR,"^",4),DAW=$P(ODR,"^",5),DIN=$P(ODR,"^",6)
  1. .S ^TMP("PSOMID",$J,II)=IRXN_"^"_FP_"^"_FPN I DIN=1 D ;;*312 - ADDED IRXN AS 4TH PIECE
  1. ..F JJ=0:0 S JJ=$O(^UTILITY($J,"PSOHL",II,JJ)) Q:'JJ S ING(JJ)=^UTILITY($J,"PSOHL",II,JJ)
  1. .S SDI=$P(ODR,"^",7) I SDI=1 S DRI=^UTILITY($J,"PSOHL",II,"DRI")
  1. .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)
  1. .I $G(STPMTR)>1&($P($G(^PSRX(IRXN,"STA")),"^")=5) D
  1. ..N PSOHLSPZ,PSOHLNDA S PSOHLSPZ=$O(^PS(52.5,"B",IRXN,0)),PSOHLNDA=""
  1. ..I PSOHLSPZ S PSOHLNDA=$G(^PS(52.5,PSOHLSPZ,0))
  1. ..I $G(RXPR(IRXN)),+$G(RXPR(IRXN))'=$P(PSOHLNDA,"^",5) Q
  1. ..I '$G(RXRP(IRXN)),'$G(RXPR(IRXN)),$D(RXFL(IRXN)),$P(PSOHLNDA,"^",13)'="",$P($G(RXFL(IRXN)),"^")'=$P(PSOHLNDA,"^",13) Q
  1. ..D SUS^PSOLBL4(IRXN,FP,FPN,RPRT)
  1. .S PSOADD=""
  1. .I PSOENH D CHKCAT I PSOADD="" Q
  1. .I PSOADD="" S PSOADD=DDNS
  1. .D LOGMSG
  1. .S PSI=$P(OPADD(PSOADD),"^",2) I PSI="" S PSI=1 K PAS,PAS1,PAS2,PAS3
  1. .D START^PSOHLDS1
  1. .M ^TMP("PSOADD",$J,PSOADD)=^TMP("PSO",$J) S $P(OPADD(PSOADD),"^",2)=PSI
  1. .I $D(ADDCAT("S")) D STRAGE
  1. .K ^TMP("PSO",$J)
  1. I $D(ADDCAT("S")) D MORSTG
  1. S PSLINK=$O(^UTILITY($J,"PSOHL",0))
  1. S DDNS="" F S DDNS=$O(^TMP("PSOADD",$J,DDNS)) Q:DDNS="" D
  1. .K ^TMP("HLS",$J)
  1. .M ^TMP("HLS",$J)=^TMP("PSOADD",$J,DDNS)
  1. .S DPORT=$P(OPADD(DDNS),"^")
  1. .K HLP,HLMID,HLERR,HLRESLT
  1. .S HLP("CONTPTR")="",HLP("SUBSCRIBER")="^^^^~"_DDNS_":"_DPORT_"~DNS"
  1. .D GENERATE^HLMA(PIEN,"GM",1,.HLRESLT,"",.HLP)
  1. .K HLL S HLMID=$P($G(HLRESLT),"^"),HLERR=$P($G(HLRESLT),"^",2)
  1. .I '$G(HLMID) S XQAMSG="Error transmitting "_$P(^DPT(DFN,0),"^")_" order to external interface"_$S(PSOENH:" TO "_DDNS,1:"") D ALERT Q
  1. .I $G(HLMID),$P($G(HLERR),"^")'="" S XQAMSG="Error transmitting batch "_HLMID_" to the external interface"_$S(PSOENH:" TO "_DDNS,1:""),MESS="TRANSMISSION FAILED"_$S(PSOENH:" TO "_DDNS,1:""),STA=3 D UFILE,ALERT Q
  1. .I $G(HLMID),$P($G(HLERR),"^")="" S MESS="MESSAGE TRANSMITTED"_$S(PSOENH:" TO "_$G(OPNAM(DDNS))_" ("_DDNS_")",1:""),STA=1 D UFILE
  1. G EXIT
  1. LOGMSG ;build status of message in log file (#52.51)
  1. N PSODEV,PSOMES,STR
  1. S PSODEV=PSOADD
  1. D LOGBLD
  1. S $P(^TMP("PSOMID",$J,II),"^",4)=PSOMES
  1. ;build message for the storage devices
  1. I PSOENH D
  1. .S PSODEV="" F S PSODEV=$O(ADDCAT("S",PSODEV)) Q:PSODEV="" I PSODEV'=PSOADD D
  1. ..D LOGBLD
  1. ..S STR=$P(^TMP("PSOMID",$J,II),"^",4),STR=$S(STR'="":STR_";",1:"")_PSOMES
  1. ..S $P(^TMP("PSOMID",$J,II),"^",4)=STR
  1. Q
  1. LOGBLD ;audit log file #52.51
  1. N DIK,DIC,DA,DD,DO
  1. S DIC="^PS(52.51,",X=IRXN,DIC(0)=""
  1. S DIC("DR")="2////"_DFN_";3////"_DTME_";4////"_PRSN_";5////"_RPRT_";6////"_STPMTR_";8////"_FP_";9////"_FPN_";15////"_DIV_";13////"_"BUILDING MESSAGE"_$S(PSOENH:" TO SEND TO "_PSODEV,1:"")_";14////1"
  1. D FILE^DICN K DD,DO,DIC
  1. S PSOMES=$P(Y,"^")
  1. K Y
  1. Q
  1. UFILE F II=0:0 S II=$O(^TMP("PSOMID",$J,II)) Q:'II S III=$G(^(II)) D
  1. .S PRXX=$P(III,"^",4),PFP=$P(III,"^",2),PFPN=$P(III,"^",3)
  1. .F XX=1:1 S PRX=$P(PRXX,";",XX) Q:PRX="" D
  1. ..Q:'$D(^PS(52.51,PRX))
  1. ..I $P($G(^PS(52.51,PRX,0)),"^",8)=PFP,$P($G(^PS(52.51,PRX,0)),"^",9)=PFPN D
  1. ...I PSOENH,$G(^PS(52.51,PRX,1))'[DDNS Q
  1. ...S DA=PRX,DIE="^PS(52.51,",DR="10////"_HLMID_";13////"_MESS_";14////"_STA_"" D ^DIE
  1. ...I PSOENH D ACLOG
  1. Q
  1. ;
  1. EXIT S:$D(ZTQUEUED) ZTREQ="@"
  1. 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,%
  1. K DA,DIE,DIV,DR,DTME,HL1,HLERR,HLPDT,XXX,DFN,PAS,STPMTR,X,III,PIEN,PRSN,RPRT,PAS1,PAS2,PAS3,PRXX,XX,J
  1. K ^TMP("HLS",$J),^TMP("PSO",$J),^TMP("PSOADD",$J)
  1. Q
  1. ;
  1. ERRMSG S EMSG=""
  1. F AA=1:1 X HLNEXT Q:HLQUIT'>0 S EMSG=EMSG_"&&"_HLNODE
  1. S ^TMP("PSO2",$J)=EMSG
  1. Q
  1. ACK ;process MSA received from the dispense machine (client)
  1. ;
  1. S:'$D(HL("APAT")) HL("APAT")="AL"
  1. S AACK=HL("APAT"),DTM=HL("DTM"),ETN=HL("ETN"),CMID=HL("MID")
  1. S MTN=HL("MTN"),RAN=HL("RAN"),SAN=HL("SAN"),VER=HL("VER")
  1. S EID=HL("EID"),EIDS=HL("EIDS"),FS=HL("FS")
  1. I $G(VER)'="2.4" G EXT
  1. N ORC K PSOMSG F I=1:1 X HLNEXT Q:HLQUIT'>0 S PSOMSG(I)=HLNODE,J=0 D
  1. .I $P(PSOMSG(I),"|")="MSA" S MSACDE=$P(PSOMSG(I),"|",2),SMID=$P(PSOMSG(I),"|",3) S:$P(PSOMSG(I),"|",4)]"" ERRMSG=$P(PSOMSG(I),"|",4)
  1. .I $P(PSOMSG(I),"|")="ORC" S ORC="1^"_+$P(PSOMSG(I),"|",3)
  1. .I $P(PSOMSG(I),"|")="RXD" S PSOFNHL7=$P(PSOMSG(I),"|",2)
  1. .F S J=$O(HLNODE(J)) Q:'J S PSOMSG(I,J)=HLNODE(J)
  1. ;
  1. I SMID'="",$D(^PSRXR(52.09,"F",SMID)) G ACK^PSORLLLI
  1. S ^TMP("PSO1",$J,CMID)=CMID_"^"_AACK_"^"_DTM_"^"_ETN_"^"_MTN_"^"_RAN_"^"_SAN_"^"_VER_"^"_EID_"^"_EIDS
  1. ;
  1. 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)
  1. I '$D(MSACDE) G EXT
  1. I $G(MSACDE)="AA" D ACK1
  1. I $G(MSACDE)="AE"!$G(MSACDE)="AR" D ACK2
  1. ;
  1. EXT ;
  1. K ^TMP("PSO1",$J),AACK,DTM,ETN,CMID,MTN,RAN,SAN,VER,EID,EIDS,FS,MSA,AA,RPT
  1. K MSA1,MSACDE,SMID,ERRMSG,DIV1,SP1,SP2,HL,UID,FLL,FLLN,IRX,FLD12,FLD13
  1. K DIE,EMSG,HLQUIT,HLNEXT,HLNODE,PSOMSG,ORC,EIN
  1. Q
  1. ;
  1. ACK1 ;
  1. S FLD13=$S($G(ORC):"MEDICATION DISPENSED",1:"TO BE PROCESSED") D FACK1
  1. Q
  1. ;
  1. ACK2 S XQAMSG="Error processing batch "_SMID_". Interface will continue to transmit.",FLD13="PROCESS FAILED" S:$G(ERRMSG) FLD12=ERRMSG
  1. D FACK2,ALERT
  1. Q
  1. ;
  1. ALERT ;send alert to key holders
  1. K XQA,XQAOPT,XQAROU,XQAID,XQADATA,XQAFLAG
  1. F UID=0:0 S UID=$O(^XUSEC("PSOINTERFACE",UID)) Q:'UID S XQA(UID)=""
  1. D SETUP^XQALERT
  1. Q
  1. UDFILE ;updates from vendor
  1. 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 (EIN,DA)=SP1 D
  1. .S DIE="^PS(52.51,",DR="7////"_SAN_";11////"_CMID_";13////"_FLD13_";14////2" D ^DIE
  1. Q
  1. FACK1 ;
  1. N RX,RXNA,RXNAQ,RXDIV
  1. D:'$G(ORC) UDFILE
  1. I $G(ORC) D
  1. . S RXNAQ=0,RXNA=$P(ORC,"^",2)
  1. . ; Trying to match via MESSAGE SERVER ID (HL7) - Should always find a match
  1. . I SMID'="" D
  1. . . S RXDIV="" F S RXDIV=$O(^PS(52.51,"AM",SMID,RXDIV)) Q:(('RXDIV)!(RXNAQ)) D
  1. . . . S RX="" F S RX=$O(^PS(52.51,"AM",SMID,RXDIV,RX)) Q:(('RX)!(RXNAQ)) D
  1. . . . . I $$GET1^DIQ(52.51,RX,.01,"I")=RXNA S (EIN,DA)=RX,RXNAQ=1
  1. . ; Trying to match with a REGULAR Fill (Non-Partials) - 'Fail Safe' matching logic
  1. . I '$G(DA) D
  1. . . S RX="" F S RX=$O(^PS(52.51,"B",RXNA,RX),-1) Q:(('RX)!(RXNAQ)) D
  1. . . . I $$GET1^DIQ(52.51,RX,8,"I")="P" Q ; Partial Fill
  1. . . . I $$GET1^DIQ(52.51,RX,9,"I")=PSOFNHL7 S (EIN,DA)=RX,RXNAQ=1
  1. . ; Trying to match with a PARTIAL Fill (OPAI returns either 0 or 1 for Partial Fill #) - 'Fail Safe' matching logic
  1. . I '$G(DA) D
  1. . . S RX="" F S RX=$O(^PS(52.51,"B",RXNA,RX),-1) Q:(('RX)!(RXNAQ)) D
  1. . . . I $$GET1^DIQ(52.51,RX,8,"I")'="P" Q ; Regular Fill
  1. . . . S (EIN,DA)=RX,RXNAQ=1
  1. . I $G(DA) D
  1. . . I $P($G(^PS(52.51,DA,1)),"^",4)="MEDICATION DISPENSED",$P(^PS(52.51,DA,0),"^",10)=2 S MDUP=1 D ^PSOHLDIS K EIN,MDUP Q
  1. . . S HLUSER=$P(^PS(52.51,DA,0),"^",4),HLRPT=$P(^(0),"^",5)
  1. . . S DIE="^PS(52.51,",DR="7////"_SAN_";11////"_CMID_";13////"_FLD13_";14////2" D ^DIE,^PSOHLDIS K EIN,HLUSER,HLRPT
  1. Q
  1. ;
  1. FACK2 ;
  1. D UDFILE Q:'$G(^PSRX($P(^PS(52.51,EIN,0),"^"),0))
  1. S ACL=0,IRX=$P(^PS(52.51,EIN,0),"^"),FLL=$P(^(0),"^",8),FLLN=$P(^(0),"^",9),RXN=$P(^PSRX(IRX,0),"^")
  1. F I=0:0 S SUB=$O(^PSRX(IRX,"A",I)) Q:'I S ACL=(ACL+1)
  1. D NOW^%DTC S ACL=ACL+1,^PSRX(IRX,"A",0)="^52.3DA^"_ACL_"^"_ACL
  1. S ^PSRX(IRX,"A",ACL,0)=%_"^N^^"_$S(FLL="F":FLLN,1:(99-FLLN))_"^External Interface Rx NOT Dispensed." K ACL,I,RXN
  1. Q
  1. ;
  1. GETDEV ;get devices associated with dispensing printer
  1. ;Create array OPADD & ADDCAT
  1. ; Output: OPADD(dns)=port
  1. ; ADDCAT(category,dns)=""
  1. ;
  1. N DDNS,DPORT,PIO,PN,DN,DEV,DAT,DAT1
  1. K OPADD,ADDCAT
  1. S PN=$G(^UTILITY($J,"PSOPAI")),PIO=$O(^PS(59,PSOSITE,"P","B",+PN,""))
  1. S DN=$O(^PS(59,PSOSITE,"P",+PIO,"OPAI",0))
  1. I ('PIO)!(DN="") D Q
  1. .S DDNS=$$GET1^DIQ(59,PSOSITE_",",2006),DPORT=$$GET1^DIQ(59,PSOSITE_",",2007),OPADD(DDNS)=DPORT
  1. S PSOENH=1,DEV=0 F S DEV=$O(^PS(59,PSOSITE,"P",PIO,"OPAI",DEV)) Q:'DEV D
  1. .S DAT=$G(^PS(59,PSOSITE,"P",PIO,"OPAI",DEV,0)) I $P(DAT,"^",2)="" Q
  1. .S DAT1=$$ADDCHK($P(DAT,"^")) I DAT1 D
  1. ..S OPADD($P(DAT1,"^",3))=$P(DAT1,"^",4),ADDCAT($P(DAT,"^",2),$P(DAT1,"^",3))=""
  1. Q
  1. ;
  1. CHKCAT ;checks the ADD category to determine if and where the prescription should be routed.
  1. N PDAT,DRG,DRG0,DDEV,RTE,CSB,MTH,DEV53
  1. S PSOADD=""
  1. I $G(PSONEADS) S DRG=PSOLDRUG,RTE=$E($G(PSOHLSV("ROUTING")))
  1. I '$G(PSONEADS) S PDAT=$G(^PSRX(IRXN,0)),DRG=$P(PDAT,"^",6),RTE=$$RTE()
  1. S DRG0=$G(^PSDRUG(+DRG,0)),DDEV=$G(^PSDRUG(DRG,"OPAI",PSOSITE,0))
  1. I DDEV'="" S DEV53=$$ADDCHK($S(RTE="W":$P(DDEV,"^",2),RTE="M":$P(DDEV,"^",3),1:"")) I DEV53 D Q
  1. .I $D(OPADD($P(DEV53,"^",3))) S PSOADD=$P(DEV53,"^",3) Q
  1. .S OPADD($P(DEV53,"^",3))=$P(DEV53,"^",4),PSOADD=$P(DEV53,"^",3)
  1. I $D(ADDCAT("A")) S PSOADD=$O(ADDCAT("A","")) Q
  1. S CSB=+$P(DRG0,"^",3),CSB=$S((CSB>0)&(CSB<6):"CS",1:"NCS")
  1. I $D(ADDCAT(CSB)) S PSOADD=$O(ADDCAT(CSB,"")) Q
  1. I $D(ADDCAT(RTE_CSB)) S PSOADD=$O(ADDCAT(RTE_CSB,"")) Q
  1. S MTH=$S(RTE="W":"WIND",RTE="M":"MAIL",1:"") I MTH'="",$D(ADDCAT(MTH)) S PSOADD=$O(ADDCAT(MTH,"")) Q
  1. I $D(ADDCAT("S")) S PSOADD=$O(ADDCAT("S","")) Q
  1. Q
  1. ;
  1. STRAGE ;set HL7 entries in ^TMP global to be sent to the storage device.
  1. N DNS,CNT,CNT1,STR
  1. S DNS=$O(ADDCAT("S","")) I DNS="" Q
  1. I DNS=PSOADD Q
  1. I '$D(^TMP("PSOADD",$J,DNS)) D Q
  1. .M ^TMP("PSOADD",$J,DNS)=^TMP("PSO",$J) S $P(OPADD(DNS),"^",2)=PSI
  1. S CNT=0 F S CNT=$O(^TMP("PSO",$J,CNT)) Q:'CNT D
  1. .S STR=$G(^TMP("PSO",$J,CNT))
  1. .I "^PID^PV1^PV2^IAM^"[("^"_$E(STR,1,3)_"^") Q
  1. .S CNT1=+$P(OPADD(DNS),"^",2)
  1. .M ^TMP("PSOADD",$J,DNS,CNT1)=^TMP("PSO",$J,CNT)
  1. .S CNT1=CNT1+1,$P(OPADD(DNS),"^",2)=CNT1
  1. Q
  1. MORSTG ;if more than one storage device is defined, add the others to the ^TMP global
  1. N RDNS,DNS
  1. S DNS=$O(ADDCAT("S","")) I DNS="" Q
  1. S RDNS=DNS F S RDNS=$O(ADDCAT("S",RDNS)) Q:RDNS="" D
  1. .M ^TMP("PSOADD",$J,RDNS)=^TMP("PSOADD",$J,DNS)
  1. Q
  1. ;
  1. ADDCHK(DEV) ;check ADD in file #52.53 and return status and the zero node
  1. ; 1 - valid or 0 - invalid
  1. I $G(DEV)="" Q 0
  1. N DEVD
  1. S DEVD=$G(^PS(52.53,DEV,0))
  1. I ($P(DEVD,"^")="")!($P(DEVD,"^",2)="")!($P(DEVD,"^",3)="") Q 0_"^"_DEVD
  1. I $P(DEVD,"^",4),$P(DEVD,"^",4)'>DT Q 0_"^"_DEVD
  1. Q 1_"^"_DEVD
  1. ;
  1. ALLADD ;get all active ADDs in #52.53
  1. ; OPNAM(dns)=dns name
  1. N X,XD
  1. K OPNAM
  1. S X=0 F S X=$O(^PS(52.53,X)) Q:'X D
  1. .S XD=$G(^PS(52.53,X,0))
  1. .Q:($P(XD,"^")="")!($P(XD,"^",2)="")!($P(XD,"^",3)="")
  1. .I $P(XD,"^",4),$P(XD,"^",4)'>DT Q
  1. .I $G(PSONECT) S PSONECTC=PSONECTC+1
  1. .S OPNAM($P(XD,"^",2))=$P(XD,"^")
  1. Q
  1. ;
  1. ACLOG ;activity log (HL7 message transmitted to the interface)
  1. N DTTM,HCOM,HCNT,HJJ,IEN52
  1. S IEN52=$P($G(^PS(52.51,PRX,0)),"^")
  1. D NOW^%DTC S DTTM=%,HCOM=MESS
  1. S HCNT=0 F HJJ=0:0 S HJJ=$O(^PSRX(IEN52,"A",HJJ)) Q:'HJJ S HCNT=HJJ
  1. S HCNT=HCNT+1,^PSRX(IEN52,"A",0)="^52.3DA^"_HCNT_"^"_HCNT S ^PSRX(IEN52,"A",HCNT,0)=DTTM_"^X^"_$S($G(PDUZ):PDUZ,1:.5)_"^"_"^"_$S($G(HLMID):"HL7 ID - "_HLMID,1:"")_" "_HCOM
  1. Q
  1. RTE() ;get RX route
  1. N MW
  1. I $G(FP)="F"&('$G(FPN)) S MW=$P($G(^PSRX(IRXN,0)),"^",11) ;original
  1. I $G(FP)="F"&($G(FPN)) S MW=$P($G(^PSRX(IRXN,1,FPN,0)),"^",2) ;refill
  1. I $G(FP)="P"&($G(FPN)) S MW=$P($G(^PSRX(IRXN,"P",FPN,0)),"^",2) ;partial
  1. Q $G(MW)