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

APSPFNC6.m

Go to the documentation of this file.
  1. APSPFNC6 ;IHS/MSC/PLS - Prescription Creation Support ;28-Mar-2016 11:53;DU
  1. ;;7.0;IHS PHARMACY MODIFICATIONS;**1011,1012,1016,1017,1018,1021**;Sep 23, 2004;Build 14
  1. ;=================================================================
  1. ;Returns string containing the possible pickup locations
  1. GPKUP(DATA,USR,OI,ORDER) ; EP -
  1. N AUTORX,RET,C,CRX,RSCH,OKERX,AUTOOR
  1. S ORDER=$G(ORDER),AUTOOR=-1
  1. ;IHS/MSC/MGH 1016 If the order number is sent in and the order is e-prescribed, then renewals must be electronic.
  1. S:ORDER'="" AUTOOR=$$CHKERX(ORDER)
  1. S C=$$GET^XPAR("ALL","APSP AUTO RX CII PRESCRIBING")
  1. S CRX=$$GET^XPAR("ALL","APSP AUTO RX ERX OF CS II")
  1. S AUTORX=+$$GET^XPAR("ALL","APSP AUTO RX")
  1. S RSCH=$$GET^XPAR("ALL","APSP AUTO RX SCHEDULE RESTRICT")
  1. I AUTORX=0 D ;Internal Pharmacy
  1. .S RET="CMW"
  1. E I AUTORX=1 D ;Internal and External Pharmacy
  1. .S OKERX=$$OKTOUSE(OI,RSCH)
  1. .I '$$ERXUSER(USR) D ;User not able to select E
  1. ..S RET=$S(OKERX=2:"P",AUTOOR>0:"CP",1:"CMWP")
  1. .E D
  1. ..;IHS/MSC/MGH Patch 1016 Changes to incorporate ERX field
  1. ..I '+OKERX D
  1. ...S RET=$S(AUTOOR>0:"CP",'AUTOOR:"CMW",1:"CMWP")
  1. ..E D
  1. ...S RET=$S(OKERX=2:"P",AUTOOR>0:"CP",'AUTOOR:"CMW",1:"CMWP")
  1. ...I AUTOOR'=0 S RET=RET_$S(OKERX>0:"E",$L(RSCH)&($$ERXOI(OI,RSCH)):"",$$ERXOI(OI,"2"):$S(CRX:"E",1:""),1:"E")
  1. E I AUTORX=2 D ;External Pharmacy
  1. .S OKERX=$$OKTOUSE(OI,RSCH)
  1. .I '$$ERXUSER(USR) D ;User not able to select E
  1. ..S RET=$S(OKERX=2:"P",1:"CP")
  1. .E D
  1. ..;IHS/MSC/MGH Patch 1016 Changes to incorporate ERX field
  1. ..I '+OKERX D
  1. ...S RET=$S(OKERX=2:"P",1:"CP")
  1. ..E D
  1. ...S RET=$S(OKERX=2:"P",1:"CP")
  1. ...S RET=RET_$S(OKERX>0:"E",$L(RSCH)&($$ERXOI(OI,RSCH)):"",$$ERXOI(OI,"2"):$S(CRX:"E",1:""),1:"E")
  1. S DATA=RET
  1. Q
  1. ; Returns ability of user to e-prescribe
  1. ; Input: USR - IEN to New Person File
  1. ; Output: 0 = e-Prescribing is not available to user
  1. ; 1 = e-Prescribing is available to user
  1. ERXUSER(USR) ; EP
  1. N RET
  1. D ERXUSER^APSPFNC2(.RET,USR)
  1. Q RET
  1. ; Returns match of orderable item to drug schedule
  1. ; Input: OIIEN - Orderable Item IEN
  1. ; SCH - SCHEDULE
  1. ; TPL - Invert return value
  1. ERXOI(OIIEN,SCH,TPL) ; EP
  1. N RET
  1. S TPL=+$G(TPL,0)
  1. D ERXOI^APSPFNC2(.RET,OIIEN,SCH)
  1. Q $S(TPL:RET,1:'RET)
  1. ; Retransmit eRX order
  1. ; Input: ORD - IEN to Order File (100)
  1. ; Output: 1 = resent
  1. RESEND(DATA,ORD,RXNUM) ;EP -
  1. N PHARM,RX
  1. S PHARM=+$$VALUE^ORCSAVE2(+ORD,"PHARMACY")
  1. S RX=+$G(^OR(100,ORD,4))
  1. I $P($G(^PSRX(RX,0)),U)=RXNUM D
  1. .D EN^APSPELRX(RX,PHARM)
  1. S DATA=1
  1. Q
  1. ; Returns boolean value representing presence of reason and type in activity log.
  1. CKRXACT(RX,REASON,TYPE) ;EP-
  1. N RES,LP,PR,PT
  1. S (LP,RES)=0
  1. Q:'$G(RX) RES
  1. Q:'$L($G(REASON)) RES
  1. S TYPE=$G(TYPE)
  1. F S LP=$O(^PSRX(RX,"A",LP)) Q:'LP D Q:RES
  1. .S PR=$P(^PSRX(RX,"A",LP,0),U,2)
  1. .Q:PR'=REASON
  1. .S PT=$P($G(^PSRX(RX,"A",LP,9999999)),U,2)
  1. .Q:PT=""
  1. .S:TYPE[PT RES=1
  1. Q RES
  1. ;Returns if this drug is OK to send as a eRX
  1. OKTOUSE(OI,RSCH) ;function call
  1. N RES,IEN,STOP,POI,NODE
  1. S RES=1
  1. I $L(RSCH)&($$ERXOI(OI,RSCH)) Q 0
  1. S POI=$P($P($G(^ORD(101.43,OI,0)),U,2),";",1)
  1. I POI="" Q RES
  1. S IEN="" F S IEN=$O(^PSDRUG("ASP",POI,IEN)) Q:IEN=""!(RES=0) D
  1. .S NODE=$G(^PSDRUG(IEN,0))
  1. .Q:NODE=""
  1. .I $P($G(^PSDRUG(IEN,999999935)),U,3)=1 S RES=0
  1. .I $$ERXONLY(IEN) S RES=2
  1. Q RES
  1. CHKERX(ORDER) ;Find out if ORDER was an eRX one
  1. N VALUE,RX
  1. S VALUE=0,ORDER=$P(ORDER,";")
  1. S RX="" S RX=$O(^PSRX("APL",ORDER,RX))
  1. Q:RX="" VALUE
  1. S VALUE=+$$GET1^DIQ(52,RX,9999999.23,"I")
  1. Q VALUE
  1. ; Return ERX only of drug
  1. ; Input: Order File IEN
  1. ; Output: Boolean
  1. ERXONLY(DRUG) ;EP- Patch 1021
  1. N VAL
  1. S VAL=$P($G(^PSDRUG(DRUG,999999935)),U,3)
  1. Q VAL=2
  1. ; Return long name of drug
  1. ; Input: Order File IEN
  1. GETLONG(RET,ORDER) ;EP-
  1. N DRUG
  1. S RET=""
  1. S DRUG=$$VALUE^ORCSAVE2(ORDER,"DRUG")
  1. Q:'+DRUG
  1. S RET=$$GETLNGDG(DRUG)
  1. Q
  1. ; Return long name of drug
  1. ; Input: Drug File IEN
  1. GETLNGDG(DRUG) ;EP-
  1. Q $$GET1^DIQ(50,DRUG,9999999.352)
  1. ;
  1. ; Find a site
  1. LOC(ORIEN) ;
  1. N PSOLOC,PSOINS,PSOSITE
  1. S PSOLOC=$P($G(^OR(100,ORIEN,0)),U,10)
  1. S PSOSITE=$$GET^XPAR("LOC.`"_PSOLOC_U_"DIV.`"_DUZ(2)_"^SYS","APSP AUTO RX DIV")
  1. I 'PSOSITE D
  1. .S PSOSITE=0
  1. .I PSOLOC["SC" D
  1. ..S PSOLOC=+PSOLOC
  1. ..S PSOINS=$P($G(^SC(PSOLOC,0)),U,4)
  1. ..Q:'PSOINS
  1. ..S PSOSITE=$$DIV(PSOINS)
  1. .S:'PSOSITE PSOSITE=$$DIV(DUZ(2))
  1. .S:'PSOSITE PSOSITE=$$DIV(+$$SITE^VASITE)
  1. Q $S($G(PSOSITE):PSOSITE,1:0)
  1. ; This screen is used by the APSP AUTO RX DIV parameter.
  1. ; Input: DIV - Pointer to Institution (4) file
  1. DIVSCN(ENT) ;
  1. I $G(ENT)["DIC(4," Q ''$$DIV(+ENT)
  1. I $G(ENT)["DIC(4.2," Q 1
  1. I $G(ENT)["SC(" Q 1
  1. Q 0
  1. ; Return Pharmacy Division
  1. DIV(INS) Q $O(^PS(59,"D",+INS,0))
  1. ;
  1. ; Returns the last activity type for requested reason
  1. LASTACT(RX,REASON) ;EP-
  1. N RES,LP,PR,PT,FLG
  1. S FLG=0,RES=""
  1. S LP=$C(1)
  1. Q:'$G(RX) RES
  1. Q:'$L($G(REASON)) RES
  1. F S LP=$O(^PSRX(RX,"A",LP),-1) Q:'LP D Q:FLG
  1. .S PR=$P(^PSRX(RX,"A",LP,0),U,2)
  1. .Q:PR'=REASON
  1. .S FLG=1
  1. .S RES=$P($G(^PSRX(RX,"A",LP,9999999)),U,2)
  1. Q RES