Index: FOIAVistA/tag/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOLBL4.m
===================================================================
--- FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOLBL4.m	(revision 631)
+++ FOIAVistA/tag/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOLBL4.m	(revision 636)
@@ -1,8 +1,7 @@
-PSOLBL4 ;BIR/RTR-Set up routine for HL7 interface ;12/19/06 10:45am
- ;;7.0;OUTPATIENT PHARMACY;**26,70,156,244,233,246**;DEC 1997;Build 12
+PSOLBL4 ;BIR/RTR-Set up routine for HL7 interface ;10/20/96
+ ;;7.0;OUTPATIENT PHARMACY;**26,70,156,244,233**;DEC 1997;Build 8
  ;External reference to ^PSDRUG supported by DBIA 221
  ;
  ;*244 - ignore RX's with a status > 11
- ;*246 - send marked drugs & print label (option 4) now working
  ;
  N DIC,AP,X,Y,DPRT,QPRT
@@ -13,12 +12,12 @@
  .F AP=0:0 S AP=$O(^PS(59,PSOSITE,"P",AP)) Q:'AP  I +$P(^PS(59,PSOSITE,"P",AP,0),"^")=DPRT S QPRT=1
  .I '$G(QPRT) S $P(PSOPAR,"^",30)=0
- Q:'$P($G(PSOPAR),"^",30)                ;HL7 interface turned off
+ Q:'$P($G(PSOPAR),"^",30)
  Q:$G(PSOEXREP)
-HL N PSODTM,HHHH,PSOQUE,HLFLAG,HLFOUR,HLINGF,HLINRX,HLINRX0,II,HLNEXT,HLRR,HLRX,HLRXY,LL,PPLHL,PSHALP,HDFN,HLDFN,HNEWDFN,HLDAI,HLOSITE,HLJUST,HLRXYZ,PSOLLN,PSOLLL,PSFLG,HDFN1,NOTMD
+HL N PSODTM,HHHH,HLCOT,HLFLAG,HLFOUR,HLINGF,HLINRX,HLINRX0,HLLOOP,HLNEXT,HLRR,HLRX,HLRXY,LL,PPLHL,PSHALP,HDFN,HLDFN,HNEWDFN,HLDAI,HLOSITE,HLJUST,HLRXYZ,PSOLLN,PSOLLL,PSFLG,HDFN1
  S HLOSITE=$P($G(PSOPAR),"^",30)
  K ^UTILITY($J,"PSOHL"),^UTILITY($J,"PSOHLL"),HLRXY
- S PPLHL=PPL
- S HLFLAG=0 F II=1:1 S HLRX=$P(PPLHL,",",II) D  Q:$G(HLFLAG)
- .S HLNEXT=$P(PPLHL,",",(II+1)) I HLNEXT=""!(HLNEXT=",") S HLFLAG=1
+ S PPLHL=PPL G:HLOSITE=4 SOMD
+ S HLFLAG=0 F HLLOOP=1:1 S HLRX=$P(PPLHL,",",HLLOOP) D  Q:$G(HLFLAG)
+ .S HLNEXT=$P(PPLHL,",",(HLLOOP+1)) I HLNEXT=""!(HLNEXT=",") S HLFLAG=1
  .Q:'$G(HLRX)
  .Q:'$D(^PSRX(HLRX,0))
@@ -27,31 +26,34 @@
  .I $P($G(^PSRX(HLRX,"STA")),"^")>11!('$P(^PSRX(HLRX,0),"^",2)) Q
  .I $G(PSODBQ) S HLRR=$O(^PS(52.5,"B",HLRX,0)) Q:'HLRR  I $G(^PS(52.5,+HLRR,"P"))=1 Q
- .;   marked drug options 3 & 4
- .I (HLOSITE=3)!(HLOSITE=4) S NOTMD=0 D  Q:NOTMD     ;quit, not marked
- ..S HLJUST=+$P($G(^PSRX(HLRX,0)),"^",6)
- ..S:'$P($G(^PSDRUG(HLJUST,6)),"^") NOTMD=1
- .S HLRXY(II,HLRX)=""                                ;Valid Rx for HL7
- .S:HLOSITE=3 HLRXYZ(HLRX)=""
- ;
- I $G(HLOSITE)=3,$D(HLRXY) D                 ;rebuild PPL print string
- .K PPL F II=1:1 S HLRX=$P(PPLHL,",",II) Q:'HLRX  D
- ..Q:$D(HLRXYZ(HLRX))
- ..S PPL=$G(PPL)_HLRX_","
- ;
-SOMDQ S (II,PSOQUE)=0 F  S II=$O(HLRXY(II)) Q:'II  S ^UTILITY($J,"PSOHLL",II)=$O(HLRXY(II,0)),PSOQUE=II
- I PSOQUE=0 G ENDHL                ;Nothing set, bypass Call to Queue
- F II=0:0 S II=$O(^UTILITY($J,"PSOHLL",II)) Q:'II  S HLINRX=^(II),HLINRX0=$G(^PSRX(HLINRX,0)) D
- .S ^UTILITY($J,"PSOHLL",II)=HLINRX_"^"_+$P(HLINRX0,"^",6)_"^"_$S($G(RXPR(HLINRX)):"P",1:"F")
+ .;Here, if Site Parameter is 3, check entry in Drug File for National Id
+ .I $G(HLOSITE)=3 S HLJUST=+$P($G(^PSRX(HLRX,0)),"^",6) I '$P($G(^PSDRUG(HLJUST,6)),"^") Q
+ .S HLRXY(HLLOOP,HLRX)="" ; VALID RXS
+ .S:$G(HLOSITE)=3 HLRXYZ(HLRX)=""
+ I $G(HLOSITE)=3,$D(HLRXY) D
+ .N HLZFLAG,HLZ,HLZRX,HLZNEXT
+ .S HLZFLAG=0 K PPL F HLZ=1:1 S HLZRX=$P(PPLHL,",",HLZ) D  Q:$G(HLZFLAG)
+ ..S HLZNEXT=$P(PPLHL,",",(HLZ+1)) I HLZNEXT=""!(HLZNEXT=",") S HLZFLAG=1
+ ..Q:'$G(HLZRX)
+ ..Q:$D(HLRXYZ(HLZRX))
+ ..I $G(RXRP(HLZRX,"RP")) D  Q
+ ...I $G(PPL)="" S PPL=HLZRX_"," Q
+ ...S PPL=PPL_HLZRX_","
+ ..I $G(PPL)="" S PPL=HLZRX_"," Q
+ ..S PPL=PPL_HLZRX_","
+SOMDQ S HLCOT=1,PSHALP="" F  S PSHALP=$O(HLRXY(PSHALP)) Q:PSHALP=""  S ^UTILITY($J,"PSOHLL",HLCOT)=$O(HLRXY(PSHALP,0)),HLCOT=HLCOT+1
+ I HLCOT=1 G ENDHL ; NOTHING SET, BYPASS CALL TO QUEUE
+ F HLCOT=0:0 S HLCOT=$O(^UTILITY($J,"PSOHLL",HLCOT)) Q:'HLCOT  S HLINRX=^(HLCOT),HLINRX0=$G(^PSRX(HLINRX,0)) D
+ .S ^UTILITY($J,"PSOHLL",HLCOT)=HLINRX_"^"_+$P(HLINRX0,"^",6)_"^"_$S($G(RXPR(HLINRX)):"P",1:"F")
  .I '$G(RXPR(HLINRX)) S HLFOUR=0 F HHHH=0:0 S HHHH=$O(^PSRX(HLINRX,1,HHHH)) Q:'HHHH  I +^(HHHH,0) S HLFOUR=HHHH
  .I '$G(RXPR(HLINRX)),$G(RXFL(HLINRX))'="" S HLFOUR=$S($G(RXFL(HLINRX))=0:0,$D(^PSRX(HLINRX,1,+$G(RXFL(HLINRX)),0)):+$G(RXFL(HLINRX)),1:$G(HLFOUR))
- .S ^UTILITY($J,"PSOHLL",II)=^UTILITY($J,"PSOHLL",II)_"^"_$S($G(RXPR(HLINRX)):RXPR(HLINRX),1:HLFOUR)_"^"_$S($P($G(^PSRX(HLINRX,3)),"^",6)&('$G(RXPR(HLINRX)))&('$G(RXFL(HLINRX))):1,1:0) D ACLOG
- .S HLINGF=0 I $P(^UTILITY($J,"PSOHLL",II),"^",5),$O(^PSRX(HLINRX,"DAI",0)) S HLINGF=1 D
- ..F LL=0:0 S LL=$O(^PSRX(HLINRX,"DAI",LL)) Q:'LL  S ^UTILITY($J,"PSOHLL",II,HLINGF)=$G(^PSRX(HLINRX,"DAI",LL,0)),HLINGF=HLINGF+1
- .S $P(^UTILITY($J,"PSOHLL",II),"^",6)=$S($G(HLINGF):1,1:0)
- .I $D(^PSRX(HLINRX,"DRI")),'$G(RXPR(HLINRX)),'$G(RXFL(HLINRX)) S ^UTILITY($J,"PSOHLL",II,"DRI")=^PSRX(HLINRX,"DRI"),$P(^UTILITY($J,"PSOHLL",II),"^",7)=1
- .E  S $P(^UTILITY($J,"PSOHLL",II),"^",7)=0
- .S $P(^UTILITY($J,"PSOHLL",II),"^",8)=0 D RPT Q:'$G(^PSRX(HLINRX,"IB"))
+ .S ^UTILITY($J,"PSOHLL",HLCOT)=^UTILITY($J,"PSOHLL",HLCOT)_"^"_$S($G(RXPR(HLINRX)):RXPR(HLINRX),1:HLFOUR)_"^"_$S($P($G(^PSRX(HLINRX,3)),"^",6)&('$G(RXPR(HLINRX)))&('$G(RXFL(HLINRX))):1,1:0) D ACLOG
+ .S HLINGF=0 I $P(^UTILITY($J,"PSOHLL",HLCOT),"^",5),$O(^PSRX(HLINRX,"DAI",0)) S HLINGF=1 D
+ ..F LL=0:0 S LL=$O(^PSRX(HLINRX,"DAI",LL)) Q:'LL  S ^UTILITY($J,"PSOHLL",HLCOT,HLINGF)=$G(^PSRX(HLINRX,"DAI",LL,0)),HLINGF=HLINGF+1
+ .S $P(^UTILITY($J,"PSOHLL",HLCOT),"^",6)=$S($G(HLINGF):1,1:0)
+ .I $D(^PSRX(HLINRX,"DRI")),'$G(RXPR(HLINRX)),'$G(RXFL(HLINRX)) S ^UTILITY($J,"PSOHLL",HLCOT,"DRI")=^PSRX(HLINRX,"DRI"),$P(^UTILITY($J,"PSOHLL",HLCOT),"^",7)=1
+ .E  S $P(^UTILITY($J,"PSOHLL",HLCOT),"^",7)=0
+ .S $P(^UTILITY($J,"PSOHLL",HLCOT),"^",8)=0 D RPT Q:'$G(^PSRX(HLINRX,"IB"))
  .I $P(^PSRX(HLINRX,"STA"),"^")>0,$P(^("STA"),"^")'=2,'$G(PSODBQ) Q
- .S $P(^UTILITY($J,"PSOHLL",II),"^",8)=1
+ .S $P(^UTILITY($J,"PSOHLL",HLCOT),"^",8)=1
  ;
 AAA D STRT^PSOHLSG5
@@ -100,6 +102,6 @@
  Q
 RPT ;
- S $P(^UTILITY($J,"PSOHLL",II),"^",9)=$S($G(PSOSUREP)!($G(RXRP(HLINRX))):1,1:0)
- S $P(^UTILITY($J,"PSOHLL",II),"^",10)=+$G(PDUZ)
+ S $P(^UTILITY($J,"PSOHLL",HLCOT),"^",9)=$S($G(PSOSUREP)!($G(RXRP(HLINRX))):1,1:0)
+ S $P(^UTILITY($J,"PSOHLL",HLCOT),"^",10)=+$G(PDUZ)
  Q
 SETZ ;
@@ -111,2 +113,15 @@
  D ^%ZTLOAD
  Q
+SOMD ;send only mark drugs to external interface and print in vista
+ S HLFLG=0 F HLLP=1:1 S HLRX=$P(PPLHL,",",HLLP) D  Q:$G(HLFLG)
+ .S HLNEXT=$P(PPLHL,",",(HLLP+1)) I HLNEXT=""!(HLNEXT=",") S HLFLG=1
+ .Q:'$G(HLRX)
+ .Q:'$D(^PSRX(HLRX,0))
+ .Q:$P($G(^PSRX(HLRX,"STA")),"^")=4
+ .I $P($G(^PSRX(HLRX,"STA")),"^")>11!('$P(^PSRX(HLRX,0),"^",2)) Q
+ .Q:$G(RXRP(HLRX,"RP"))
+ .S HLRR=$O(^PS(52.5,"B",HLRX,0)) Q:'HLRR  I $G(^PS(52.5,+HLRR,"P"))=1 K HLRR Q
+ .S DRG=+$P($G(^PSRX(HLRX,0)),"^",6) I '$P($G(^PSDRUG(DRG,6)),"^") Q
+ .S HLRXY(HLRX)="" ; VALID RXS
+ I $D(HLRXY) G SOMDQ
+ Q
