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

PSO52API.m

Go to the documentation of this file.
  1. PSO52API ;BHAM ISC/SAB - Encap II API to return Rx data ; Feb 17, 2023@08:16:38
  1. ;;7.0;OUTPATIENT PHARMACY;**213,229,252,387,386,566,441,712,744**;DEC 1997;Build 3
  1. ; Reference to ^PS(55 in ICR #2228
  1. ;
  1. RX(DFN,LIST,IEN,RX,NODE,SDATE,EDATE) ;
  1. ;DFN: IEN from the PATIENT file (#2) [REQUIRED]
  1. ;LIST: Subscript name used in ^TMP global [REQUIRED]
  1. ;IEN: Internal prescription number [optional]
  1. ;RX#: RX # field (#.01) of the PRESCRIPTION file (#52) [optional]
  1. ;NODE: Determines data elements returned [optional]
  1. ;SDATE: Start Date [optional]
  1. ;EDATE: End Date [optional]
  1. ;
  1. Q:'$G(DFN) Q:$G(LIST)=""
  1. N DA,DR,PST,DIC,DIQ,ND,LK,DTE,DAT,I,X,D0 K ^TMP($J,LIST) S ^TMP($J,LIST,DFN,0)=0
  1. I $G(IEN) D PROCESS G CLEAN
  1. I $G(RX)]"",'$G(IEN) S IEN=$O(^PSRX("B",RX,0)) D G CLEAN
  1. .I 'IEN S ^TMP($J,LIST,DFN,0)="-1^NO DATA FOUND" Q
  1. .D PROCESS
  1. D DATE
  1. CLEAN F I=0:0 S I=$O(^TMP($J,LIST,DFN,I)) Q:'I S ^TMP($J,LIST,DFN,0)=^TMP($J,LIST,DFN,0)+1
  1. I ^TMP($J,LIST,DFN,0)=0 S ^TMP($J,LIST,DFN,0)="-1^NO DATA FOUND"
  1. K DA,DR,DIC,ND,DAT,PST,LK,DIQ,DTE,I,X
  1. Q
  1. PROCESS ;
  1. I DFN'=$P($G(^PSRX(IEN,0)),"^",2) S ^TMP($J,LIST,IEN,0)="-1^NO DATA FOUND (MISMATCHED PATIENT)" Q
  1. I $G(^PSRX(IEN,0))']"" S ^TMP($J,LIST,IEN,0)="-1^NO RX DATA FOUND" Q
  1. ;
  1. ; - Rx Auto Expiration
  1. N RXSTS,RXEXPDT
  1. S RXSTS=+$G(^PSRX(IEN,"STA")),RXEXPDT=$$GET1^DIQ(52,IEN,26,"I")
  1. I (RXSTS<11)!(RXSTS=16),(RXEXPDT<DT) D
  1. .S RXSTS=11 N DIE,DIC,DR,DA,STAT,PHARMST,COMM
  1. .S DIE=52,DA=IEN,DR="100////11" D ^DIE K DIE,DIC,DR
  1. .D ECAN^PSOUTL(IEN)
  1. .S STAT="SC",PHARMST="ZE",COMM="Medication Expired on "_$$FMTE^XLFDT(RXEXPDT,2)
  1. .D EN^PSOHLSN1(IEN,STAT,PHARMST,COMM)
  1. ;
  1. I $G(NODE)']"" D ZE,TW,TH,MI,ST,RF,CM,AT,LB,CPRS,PT^PSO52B,SD^PSO52B,TB^PSO52B,OI^PSO52B,MLT^PSO52B,IND S DAT="I" D IB Q
  1. D ST F LK=1:1:$L(NODE,",") S DAT=$P(NODE,",",LK),ND=$P(DAT,"^") D
  1. .I ND=0 D ZE Q
  1. .I ND=2 D ZE,TW Q
  1. .I ND=3 D TW,TH Q
  1. .I ND="R" D RF Q
  1. .I ND="I" D IB Q
  1. .I ND="P" D PT^PSO52B Q
  1. .I ND="O" D OI^PSO52B Q
  1. .I ND="T" D TB^PSO52B Q
  1. .I ND="L" D LB Q
  1. .I ND="S" D SD^PSO52B Q
  1. .I ND="M" D MI Q
  1. .I ND="C" D CM Q
  1. .I ND="A" D AT Q
  1. .I ND="ST" D ST Q
  1. .I ND="CPRS" D CPRS Q
  1. .I ND="ICD" D MLT^PSO52B Q
  1. .I ND="IND" D IND Q
  1. .S ^TMP($J,LIST,DFN,IEN,"INVALID REQUEST",ND)="Invalid Data Requested"
  1. Q
  1. ZE ;zero
  1. K PST S DIC=52,DA=IEN,DR=".01:9;10.3;10.6;11;14;16;17" D DIQ
  1. F DR=.01,1,2,3,4,5,6,6.5,7,8,9,10.3,10.6,11,14,16,17 D
  1. .I PST(52,DA,DR,"E")'=PST(52,DA,DR,"I") S ^TMP($J,LIST,DFN,IEN,DR)=PST(52,DA,DR,"I")_"^"_PST(52,DA,DR,"E") Q
  1. .S ^TMP($J,LIST,DFN,IEN,DR)=PST(52,DA,DR,"I")
  1. K DA,DR,PST,DIC,DIQ
  1. Q
  1. TW ;two
  1. Q:'$D(^PSRX(IEN,2))
  1. K PST S DIC=52,DA=IEN,DR="20:31;32.1;32.2;32.3;104" D DIQ
  1. F DR=20,21,22,23,24,25,26,27,28,29,30,31,32.1,32.2,32.3,104 D
  1. .I PST(52,DA,DR,"E")'=PST(52,DA,DR,"I") S ^TMP($J,LIST,DFN,IEN,DR)=PST(52,DA,DR,"I")_"^"_PST(52,DA,DR,"E") Q
  1. .S ^TMP($J,LIST,DFN,IEN,DR)=PST(52,DA,DR,"I")
  1. K DA,DR,PST,DIC,DIQ
  1. Q
  1. TH ;three
  1. Q:'$D(^PSRX(IEN,3))
  1. K PST S DIC=52,DA=IEN,DR="12;26.1;34.1;101;102;102.1;102.2;109;112" D DIQ
  1. F DR=12,26.1,34.1,101,102,102.1,102.2,109,112 D
  1. .I PST(52,DA,DR,"E")'=PST(52,DA,DR,"I") S ^TMP($J,LIST,DFN,IEN,DR)=PST(52,DA,DR,"I")_"^"_PST(52,DA,DR,"E") Q
  1. .S ^TMP($J,LIST,DFN,IEN,DR)=PST(52,DA,DR,"I")
  1. K DA,DR,PST,DIC,DIQ
  1. Q
  1. MI ;sig
  1. I $P($G(^PSRX(IEN,"SIG")),"^",2) D Q
  1. .I '$O(^PSRX(IEN,"SIG1",0)) S ^TMP($J,LIST,DFN,IEN,"M",0)="-1^NO DATA FOUND" Q
  1. .F I=0:0 S I=$O(^PSRX(IEN,"SIG1",I)) Q:'I S ^TMP($J,LIST,DFN,IEN,"M",I,0)=^PSRX(IEN,"SIG1",I,0),^TMP($J,LIST,DFN,IEN,"M",0)=$G(^TMP($J,LIST,DFN,IEN,"M",0))+1
  1. I $P($G(^PSRX(IEN,"SIG")),"^")']"" S ^TMP($J,LIST,DFN,IEN,"M",0)="-1^NO DATA FOUND" Q
  1. S X=$P($G(^PSRX(IEN,"SIG")),"^") D SIG^PSOHELP S ^TMP($J,LIST,DFN,IEN,"M",1,0)=$E(INS1,2,9999999),^TMP($J,LIST,DFN,IEN,"M",0)=1
  1. K X,INS1
  1. Q
  1. ST ;status
  1. I DT>$P(^PSRX(IEN,2),"^",6),$P(^PSRX(IEN,"STA"),"^")<11 D
  1. .N PSOEXRX,PSOEXSTA,ORN,PIFN,PSUSD,PRFDT,PDA,PSST
  1. .S PSOEXRX=IEN D EN2^PSOMAUEX K PSOEXRX,PSONM,PSONMX
  1. K PST S DIC=52,DA=IEN,DR=".01;100" D DIQ
  1. I PST(52,DA,100,"E")="DRUG INTERACTIONS" S PST(52,DA,100,"E")="NON-VERIFIED"
  1. S ^TMP($J,LIST,DFN,IEN,100)=PST(52,DA,100,"I")_"^"_PST(52,DA,100,"E")
  1. I PST(52,DA,100,"E")="ACTIVE",$G(^PSRX(DA,"PARK")),(LIST="OROCLST"!(LIST["MHV")!($E(LIST,1,4)="GMTS")) S ^TMP($J,LIST,DFN,IEN,100)=^TMP($J,LIST,DFN,IEN,100)_"/PARKED"
  1. S ^TMP($J,LIST,"B",PST(52,DA,.01,"E"),IEN)=""
  1. K DA,DR,PST,DIC,DIQ
  1. Q
  1. RF ;refill
  1. I '$O(^PSRX(IEN,1,0)) S ^TMP($J,LIST,DFN,IEN,"RF",0)="-1^NO DATA FOUND" Q
  1. I $P($G(DAT),"^",3) S DA(52.1)=$P(DAT,"^",3) D RFD K DA,DR,PST,DIC,DIQ Q
  1. F RF=0:0 S RF=$O(^PSRX(IEN,1,RF)) Q:'RF S DA(52.1)=RF D RFD
  1. K DA,DR,PST,DIC,DIQ,RF
  1. Q
  1. RFD K PST S DR(52.1)=".01:8;10.1;11;12;13;14;15;17;23",DIC=52,DA=IEN,DR=52 D DIQ
  1. I $P($G(DAT),"^",3),'$G(PST(52.1,DA(52.1),.01,"I")) S ^TMP($J,LIST,DFN,IEN,"RF",0)="-1^NO DATA FOUND" Q
  1. S ^TMP($J,LIST,DFN,IEN,"RF",0)=$G(^TMP($J,LIST,DFN,IEN,"RF",0))+1
  1. F DR=.01,1,1.1,1.2,2,3,4,5,6,7,8,10.1,11,12,13,14,15,17,23 D
  1. .I PST(52.1,DA(52.1),DR,"E")'=PST(52.1,DA(52.1),DR,"I") S ^TMP($J,LIST,DFN,IEN,"RF",DA(52.1),DR)=PST(52.1,DA(52.1),DR,"I")_"^"_PST(52.1,DA(52.1),DR,"E") Q
  1. .S ^TMP($J,LIST,DFN,IEN,"RF",DA(52.1),DR)=PST(52.1,DA(52.1),DR,"I")
  1. Q
  1. IB ;ib ori
  1. I $P($G(DAT),"^",2)="R" D IBR Q
  1. I $G(^PSRX(IEN,"IB"))']"" S ^TMP($J,LIST,DFN,IEN,"IB",0)="-1^NO DATA FOUND" Q
  1. K PST S DIC=52,DA=IEN,DR="105;106;106.5;106.6" D DIQ
  1. F DR=105,106,106.5,106.6 D
  1. .I PST(52,DA,DR,"E")'=PST(52,DA,DR,"I") S ^TMP($J,LIST,DFN,IEN,DR)=PST(52,DA,DR,"I")_"^"_PST(52,DA,DR,"E") Q
  1. .S ^TMP($J,LIST,DFN,IEN,DR)=PST(52,DA,DR,"E")
  1. K DA,DR,PST,DIC,DIQ
  1. I $P($G(DAT),"^",2)="" D IBR Q
  1. Q
  1. IBR ;ib ref
  1. I '$O(^PSRX(IEN,1,0)) S ^TMP($J,LIST,DFN,IEN,"IB",0)="-1^NO DATA FOUND" Q
  1. I $P($G(DAT),"^",2)="R",$P($G(DAT),"^",3) S DA(52.1)=$P(DAT,"^",3) D IBS K DA,DR,PST,DIC,DIQ Q
  1. N IB F IB=0:0 S IB=$O(^PSRX(IEN,1,IB)) Q:'IB S DA(52.1)=IB D IBS
  1. I '$G(^TMP($J,LIST,DFN,IEN,"IB",0)) K ^TMP($J,LIST,DFN,IEN,"IB") S ^TMP($J,LIST,DFN,IEN,"IB",0)="-1^NO DATA FOUND"
  1. K DA,DR,PST,DIC,DIQ,IB
  1. Q
  1. IBS I $P($G(DAT),"^",3),'$G(^PSRX(IEN,1,DA(52.1),"IB")) S ^TMP($J,LIST,DFN,IEN,"IB",0)="-1^NO DATA FOUND" Q
  1. I '$D(^PSRX(IEN,1,DA(52.1),"IB")) S ^TMP($J,LIST,DFN,IEN,"IB",DA(52.1),0)="-1^NO DATA FOUND" Q
  1. K PST S DR(52.1)="9;9.1",DIC=52,DA=IEN,DR=52 D DIQ
  1. S ^TMP($J,LIST,DFN,IEN,"IB",0)=$G(^TMP($J,LIST,DFN,IEN,"IB",0))+1
  1. F DR=9,9.1 D
  1. .I PST(52.1,DA(52.1),DR,"E")'=PST(52.1,DA(52.1),DR,"I") S ^TMP($J,LIST,DFN,IEN,"IB",DA(52.1),DR)=PST(52.1,DA(52.1),DR,"I")_"^"_PST(52.1,DA(52.1),DR,"E") Q
  1. .S ^TMP($J,LIST,DFN,IEN,"IB",DA(52.1),DR)=PST(52.1,DA(52.1),DR,"I")
  1. Q
  1. CM ;cmop
  1. I '$O(^PSRX(IEN,4,0)) S ^TMP($J,LIST,DFN,IEN,"C",0)="-1^NO DATA FOUND" Q
  1. N CM F CM=0:0 S CM=$O(^PSRX(IEN,4,CM)) Q:'CM S DA(52.01)=CM D CMP
  1. K DA,DR,PST,DIC,DIQ,CM
  1. Q
  1. CMP S ^TMP($J,LIST,DFN,IEN,"C",0)=$G(^TMP($J,LIST,DFN,IEN,"C",0))+1
  1. K PST S DR(52.01)=".01;2;3;4;9:12",DIC=52,DA=IEN,DR=400 D DIQ
  1. F DR=.01,2,3,4,9,10,11,12 D
  1. .I PST(52.01,DA(52.01),DR,"E")'=PST(52.01,DA(52.01),DR,"I") S ^TMP($J,LIST,DFN,IEN,"C",DA(52.01),DR)=PST(52.01,DA(52.01),DR,"I")_"^"_PST(52.01,DA(52.01),DR,"E") Q
  1. .S ^TMP($J,LIST,DFN,IEN,"C",DA(52.01),DR)=PST(52.01,DA(52.01),DR,"I")
  1. Q
  1. AT ;activity log
  1. I '$O(^PSRX(IEN,"A",0)) S ^TMP($J,LIST,DFN,IEN,"A",0)="-1^NO DATA FOUND" Q
  1. ;P744 Check for missing Activity Log Header node and fix
  1. I '$D(^PSRX(IEN,"A",0)) D
  1. . S COUNT="" S COUNT=$O(^PSRX(IEN,"A","Z"),-1)
  1. . S ^PSRX(IEN,"A",0)="^52.3DA^"_COUNT_"^"_COUNT
  1. N AT F AT=0:0 S AT=$O(^PSRX(IEN,"A",AT)) Q:'AT S DA(52.3)=AT D ATP
  1. K DA,DR,PST,DIC,DIQ,AT
  1. Q
  1. ATP K PST S DR(52.3)=".01;.02;.03;.04;.05" S DIC=52,DA=IEN,DR=40 D DIQ
  1. S ^TMP($J,LIST,DFN,IEN,"A",0)=$G(^TMP($J,LIST,DFN,IEN,"A",0))+1
  1. F DR=.01,.02,.03,.04,.05 D
  1. .I DR=.04 S ^TMP($J,LIST,DFN,IEN,"A",DA(52.3),DR)=PST(52.3,DA(52.3),DR,"E") Q
  1. .I PST(52.3,DA(52.3),DR,"E")'=PST(52.3,DA(52.3),DR,"I") S ^TMP($J,LIST,DFN,IEN,"A",DA(52.3),DR)=PST(52.3,DA(52.3),DR,"I")_"^"_PST(52.3,DA(52.3),DR,"E") Q
  1. .S ^TMP($J,LIST,DFN,IEN,"A",DA(52.3),DR)=PST(52.3,DA(52.3),DR,"I")
  1. I $O(^PSRX(IEN,"A",AT,2,0)) D OC
  1. Q
  1. OC ;Activity Log Other Comments
  1. N PSOOC,PSOOCD
  1. F PSOOC=0:0 S PSOOC=$O(^PSRX(IEN,"A",DA(52.3),2,PSOOC)) Q:'PSOOC D
  1. .S PSOOCD=$G(^PSRX(IEN,"A",DA(52.3),2,PSOOC,0)) I PSOOCD'="" S ^TMP($J,LIST,DFN,IEN,"A",DA(52.3),"OC",PSOOC,.01)=PSOOCD
  1. Q
  1. LB ;label log
  1. I '$O(^PSRX(IEN,"L",0)) S ^TMP($J,LIST,DFN,IEN,"L",0)="-1^NO DATA FOUND" Q
  1. N LB F LB=0:0 S LB=$O(^PSRX(IEN,"L",LB)) Q:'LB S DA(52.032)=LB D LBP
  1. K DA,DR,PST,DIC,DIQ,LB
  1. Q
  1. LBP S ^TMP($J,LIST,DFN,IEN,"L",0)=$G(^TMP($J,LIST,DFN,IEN,"L",0))+1
  1. K PST S DR(52.032)=".01;1;2;3;4" S DIC=52,DA=IEN,DR=32 D DIQ
  1. F DR=.01,1,2,3,4 D
  1. .I DR=1 S ^TMP($J,LIST,DFN,IEN,"L",DA(52.032),DR)=PST(52.032,DA(52.032),DR,"E") Q
  1. .I PST(52.032,DA(52.032),DR,"E")'=PST(52.032,DA(52.032),DR,"I") S ^TMP($J,LIST,DFN,IEN,"L",DA(52.032),DR)=PST(52.032,DA(52.032),DR,"I")_"^"_PST(52.032,DA(52.032),DR,"E") Q
  1. .S ^TMP($J,LIST,DFN,IEN,"L",DA(52.032),DR)=PST(52.032,DA(52.032),DR,"I")
  1. K DA,DR,PST,DIC,DIQ
  1. Q
  1. CPRS ;CPRS number
  1. K PST S DIC=52,DA=IEN,DR=39.3 D DIQ
  1. I $G(PST(52,DA,DR,"E"))']"" S ^TMP($J,LIST,DFN,DA,DR)="" Q
  1. I PST(52,DA,DR,"E")'=PST(52,DA,DR,"I") S ^TMP($J,LIST,DFN,IEN,DR)=PST(52,DA,DR,"I")_"^"_PST(52,DA,DR,"E") Q
  1. S ^TMP($J,LIST,DFN,IEN,DR)=PST(52,DA,DR,"I")
  1. K DA,DR,PST,DIC,DIQ
  1. Q
  1. DATE ;date range
  1. I $G(SDATE) S DTE=SDATE-1 D Q
  1. .I $G(EDATE) D Q
  1. ..F S DTE=$O(^PS(55,DFN,"P","A",DTE)) Q:'DTE!(DTE>EDATE) F IEN=0:0 S IEN=$O(^PS(55,DFN,"P","A",DTE,IEN)) Q:'IEN D:$P($G(^PSRX(IEN,"STA")),"^")'=13 PROCESS
  1. .F S DTE=$O(^PS(55,DFN,"P","A",DTE)) Q:'DTE F IEN=0:0 S IEN=$O(^PS(55,DFN,"P","A",DTE,IEN)) Q:'IEN D:$P($G(^PSRX(IEN,"STA")),"^")'=13 PROCESS
  1. I $G(EDATE),'$G(SDATE) S DTE=DT-1 D Q
  1. .F S DTE=$O(^PS(55,DFN,"P","A",DTE)) Q:'DTE!(DTE>EDATE) F IEN=0:0 S IEN=$O(^PS(55,DFN,"P","A",DTE,IEN)) Q:'IEN D:$P($G(^PSRX(IEN,"STA")),"^")'=13 PROCESS
  1. S DTE=DT-1 F S DTE=$O(^PS(55,DFN,"P","A",DTE)) Q:'DTE F IEN=0:0 S IEN=$O(^PS(55,DFN,"P","A",DTE,IEN)) Q:'IEN D:$P($G(^PSRX(IEN,"STA")),"^")'=13 PROCESS
  1. Q
  1. PROF(DFN,LIST,SDATE,EDATE) ;
  1. D ^PSO52AP1
  1. Q
  1. IND ;Indication
  1. S:$P($G(^PSRX(IEN,"IND")),U)]"" ^TMP($J,LIST,DFN,IEN,"IND")=$P($G(^PSRX(IEN,"IND")),U,1,2)
  1. Q
  1. DIQ ;process fields
  1. S DIQ="PST",DIQ(0)="IE" D EN^DIQ1
  1. Q