Context Navigation

C0XPT3.m@ 1669

Last change on this file since 1669 was 1624, checked in by Sam Habiel, 12 years ago
Various fixes for drug import; better coding documentation
File size: 11.3 KB

Rev	Line
[1624]	1	C0XPT3 ;ISI/MLS,VEN/SMH -- MEDS IMPORT ;2013-05-06 4:35 PM
[1608]	2	;;1.0;FILEMAN TRIPLE STORE;;Jun 26,2012;Build 29
[1619]	3	; (C) Sam Habiel 2013
	4	; Proprietary code. Stay out!
[1607]	5	;
	6	MEDS(G,DFN) ; Private Proc; Extract Medication Data from a Patient's Graph
	7	; G - Patient Graph, DFN - you should know this
	8	K ^TMP($J,"MEDS")
	9	D ONETYPE^C0XGET3($NA(^TMP($J,"MEDS")),G,"sp:Medication")
	10	;
[1616]	11	; PRIVATE TO SAM -- PRIVATE TO SAM -- PRIVATE TO SAM
	12	; Delete the old drugs for this patient
	13	N DIK,DA
	14	S DIK="^PS(55,",DA=DFN D ^DIK ; bye bye
	15	S DIK="^PSRX(" F DA=0:0 S DA=$O(^PSRX(DA)) Q:'DA D:$P(^(DA,0),U,2)=DFN ^DIK
	16	S DIK="^OR(100," F DA=0:0 S DA=$O(^OR(100,DA)) Q:'DA D:+$P(^(DA,0),U,2)=DFN ^DIK
	17	; PRIVATE TO SAM -- PRIVATE TO SAM -- PRIVATE TO SAM
	18	;
[1613]	19	; For each medication (C0XI = COUNTER; S = Medication Node as Subject)
[1609]	20	N C0XI,S F C0XI=0:0 S C0XI=$O(^TMP($J,"MEDS",C0XI)) Q:'C0XI S S=^(C0XI) DO MED1(G,S,DFN)
[1607]	21	K ^TMP($J,"MEDS")
	22	QUIT
[1608]	23	;
[1609]	24	MED1(G,S,DFN) ; Private Procedure; Process each medication in Graph.
[1607]	25	; G = Graph; S = Medication Description ID as subject.
	26	;
	27	; 1. Start Date; obtain and then conv to fileman format
	28	N STARTDT S STARTDT=$$GSPO1^C0XGET3(G,S,"sp:startDate") ; Duh! Start Date.
[1608]	29	D
	30	. N %DT,X,Y S X=STARTDT D ^%DT S STARTDT=Y ; New stack level for variables.
[1607]	31	;
	32	;DEBUG.ASSERT that STARTDT is greater than 1900
	33	I STARTDT'>2000000 S $EC=",U1,"
	34	;
	35	; 2. Frequency
	36	N FVALUE S FVALUE=$$GSPO1^C0XGET3(G,S,"sp:frequency.sp:value")
	37	N FUNIT S FUNIT=$$GSPO1^C0XGET3(G,S,"sp:frequency.sp:unit")
	38	;
	39	; 3. Dose Quantity
	40	; Get value, get unit and strip the braces out.
	41	N DOSE S DOSE=$$GSPO1^C0XGET3(G,S,"sp:quantity.sp:value")
	42	N DUNIT S DUNIT=$$GSPO1^C0XGET3(G,S,"sp:quantity.sp:unit"),DUNIT=$TR(DUNIT,"{}")
	43	;
	44	; 4. Instructions
	45	N INST S INST=$$GSPO1^C0XGET3(G,S,"sp:instructions")
	46	;
	47	; 5. Drug Name and Code
[1608]	48	N RXN S RXN=$$GSPO1^C0XGET3(G,S,"sp:drugName.sp:code"),RXN=$P(RXN,"/",$L(RXN,"/")) ; RxNorm Code
[1607]	49	N DN S DN=$$GSPO1^C0XGET3(G,S,"sp:drugName.dcterms:title") ; Drug Name
	50	;
[1616]	51	W S," ",FVALUE_FUNIT," ",DOSE," ",DUNIT," ",INST," ",DN," ",RXN,!
[1607]	52	;
	53	; 6. Get Fill Dates
[1608]	54	N FULF ; Fulfillments
	55	D GSPO^C0XGET3($NA(FULF),G,S,"sp:fulfillment")
	56	;
	57	N FILLS ; Fills array. Contains every time a drug was dispensed.
	58	N FILL S FILL="" F S FILL=$O(FULF(FILL)) Q:FILL="" D
	59	. N S S S=FULF(FILL) ; New subject; subsumes above one in this loop
	60	. ;
	61	. ; Dispense Date
	62	. N FILLDATE S FILLDATE=$$GSPO1^C0XGET3(G,S,"dcterms:date")
	63	. D
	64	. . N %DT,X,Y S X=FILLDATE D ^%DT S FILLDATE=Y
	65	. I FILLDATE<2000000 W $EC=",U1," ; Converstion error
	66	. ;
[1624]	67	. S FILLS=$G(FILLS)+1 ; Counter for number of dispenses
[1608]	68	. S FILLS(RXN,FILLDATE,"sp:dispenseDaysSupply")=$$GSPO1^C0XGET3(G,S,"sp:dispenseDaysSupply") ; Self Explanatory?
	69	. ;
	70	. ; Get quantity value and unit
	71	. S FILLS(RXN,FILLDATE,"sp:quantityDispensed.sp:value")=$$GSPO1^C0XGET3(G,S,"sp:quantityDispensed.sp:value")
	72	. S FILLS(RXN,FILLDATE,"sp:quantityDispensed.sp:unit")=$TR($$GSPO1^C0XGET3(G,S,"sp:quantityDispensed.sp:unit"),"{}")
	73	;
[1624]	74	; ZWRITE:$D(FILLS) FILLS
[1608]	75	;
[1624]	76	; Prepare to add drug to patient record
[1609]	77	D
	78	. N FILDT,FILQTY,FILDAYS
[1624]	79	. S FILDT=$O(FILLS(RXN,"")) ; Get first fill.
	80	. I FILDT S FILQTY=FILLS(RXN,FILDT,"sp:quantityDispensed.sp:value"),FILDAYS=FILLS(RXN,FILDT,"sp:dispenseDaysSupply") ; extract fill data
	81	. E S (FILQTY,FILDAYS)="",FILDT=STARTDT ; Technically, the drug is invalid since there is no fill. But this is a kludge.
	82	. D PREP(DFN,RXN,INST,FILDT,FILQTY,FILDAYS,.FILLS) ; Add drug to patient record
[1607]	83	;
[1609]	84	QUIT
[1613]	85	;
[1624]	86	PREP(DFN,RXN,INST,FILDT,FILQTY,FILDAYS,FILLS) ; Private EP to add drug to patient record
	87	; - DFN
	88	; - RXN - RxNorm CUI
	89	; - INST - Instructions (1 tablet daily etc)
	90	; - FILDT - Earliest Fill Date
	91	; - FILQTY - Fill quantity of earliest fill date, used as default
	92	; - FILDAYS - Days Supply
	93	; - FILLS - Array specificed above - ByRef
	94	;
[1613]	95	; TODO:
	96	; 3. Don't file a med twice! Check ^PXRMINDX to make sure it aint there first
[1624]	97	; 6. Coded sig (FVALUE, FUNIT, DOSE, DUNIT) - goes into SIG1 multiple and Med Instructions multiple
	98	; 7. Fill label log section of Rx? Maybe not - goes into Label Date/Time multiple
	99	; 8. ICD Diangosis multiple if we have the data
[1616]	100	;
	101	I '$$EXIST^C0CRXNLK(RXN) S $EC=",U1," ; Invalid RxNorm code passed.
	102	;
[1609]	103	N ORZPT,PSODFN S (ORZPT,PSODFN)=DFN ;"" ;POINTER TO PATIENT FILE (#2)
	104	N PNTSTAT S PNTSTAT=20 ; NON-VA ;RX PATIENT STATUS FILE (#53)
	105	N PROV S PROV=$$NP^C0XPT0() ;NEW PERSON FILE (#200)
[1616]	106	I $$ISBRAND^C0CRXNLK(RXN) S RXN=$$BR2GEN^C0CRXNLK(RXN) ; Get Generic Drug for Brand
	107	N LOCALDRUG S LOCALDRUG=+$$RXN2MEDS^C0CRXNLK(RXN)
[1619]	108	; I 'LOCALDRUG S LOCALDRUG=$$ADDDRUG^C0CRXNAD(RXN)
	109	I LOCALDRUG N DIK,DA S DIK="^PSDRUG(",DA=LOCALDRUG D ^DIK
	110	S LOCALDRUG=$$ADDDRUG^C0CRXNAD(RXN)
[1616]	111	W "(debug) Local Drug IEN: "_LOCALDRUG,!
	112	N PSODRUG S PSODRUG=LOCALDRUG ;POINTER TO DRUG FILE (#50) ; TODO: HARDCODED; RXN
[1609]	113	S PSODRUG("DEA")=$P($G(^PSDRUG(PSODRUG,0)),U,3)
	114	N QTY S QTY=FILQTY ; NUMBER ;0;7 NUMBER (Required)
	115	N DAYSUPLY S DAYSUPLY=FILDAYS ;NUMBER ; 0;8 NUMBER (Required);
[1624]	116	N REFIL S REFIL=$S($G(FILLS):FILLS-1,1:0) ;NUMBER ; 0;9 NUMBER (Required) ; # of dispenses - 1, if there are any
[1609]	117	N ORDCONV S ORDCONV=1 ;'1' FOR ORDER CONVERTED;'2' FOR EXPIRATION TO CPRS;
	118	N COPIES S COPIES=1 ;NUMBER
	119	N MLWIND S MLWIND="W" ; Mail/Window: 'M' or 'W'
	120	N ENTERBY S ENTERBY=.5 ;NEW PERSON FILE (#200) - POSTMASTER
	121	N UNITPRICE S UNITPRICE=$P(^PSDRUG(PSODRUG,660),U,6) ;0.009 ;"" ;NUMBER
	122	N PSOSITE S PSOSITE=$O(^PS(59,0)) ; OUTPATIENT SITE FILE (#59); get first one
	123	N %,LOGDT D NOW^%DTC S LOGDT=% ;LOGIN DATE ; 2;1 DATE (Required)
	124	N FILLDT S FILLDT=FILDT ;DATE; First fill date from our data.
	125	N ISSDT S ISSDT=FILLDT ;DATE
	126	N DISPDT S DISPDT=ISSDT ;DATE
	127	N X D
	128	. N X1,X2
	129	. S X1=DISPDT,X2=180 D C^%DTC ;Default expiration of T+180
	130	N EXPIRDT S EXPIRDT=X ;
	131	N PORDITM S PORDITM=$P($G(^PSDRUG(PSODRUG,2)),U,1) ;PHARMACY ORDERABLE ITEM FILE (#50.7)
	132	N STATUS S STATUS=0 ;STA;1 SET (Required) ; '0' FOR ACTIVE;
	133	N TRNSTYP S TRNSTYP=1 ; IB ACTION TYPE FILE (#350.1)
	134	N LDISPDT S LDISPDT=FILLDT ; 3;1 DATE
	135	N REASON S REASON="E" ;Activity log ; SET ([E]dit)
[1613]	136	N INIT S INIT=.5 ;NEW PERSON FILE (#200)
[1609]	137	N SIG S SIG=INST ;#51,.01
[1607]	138	;
[1609]	139	CREATE ; fall through
[1607]	140	;
[1609]	141	N PSONEW
[1608]	142	D AUTO^PSONRXN ;RX auto number
[1609]	143	I $G(PSONEW("RX #"))="" S $EC=",U1," ; Auto-numbering not turned on!
	144	N RXNUM S RXNUM=PSONEW("RX #") ; Rx Number, again...
[1607]	145	;
[1609]	146	L +^PSRX(0):0 ; Lock zero node while we get the record.
[1616]	147	N PSOIEN S PSOIEN=$O(^PSRX(" "),-1)+1 ; Next available IEN
[1609]	148	I $D(^PSRX(PSOIEN)) S $EC=",U1," ; Next number not available. File issue.
	149	S $P(^PSRX(0),U,3)=PSOIEN ; Reset next available number.
	150	S $P(^PSRX(PSOIEN,0),"^",1)=RXNUM ; 0;1 FREE TEXT (Required)
[1613]	151	L +^PSRX(PSOIEN):0 ; Lock record node
[1609]	152	L -^PSRX(0) ; Unlock zero node, we now got it
[1607]	153	;
	154	S $P(^PSRX(PSOIEN,0),"^",13)=ISSDT ; 0;13 DATE (Required)
	155	S $P(^PSRX(PSOIEN,0),"^",2)=ORZPT ;POINTER TO PATIENT FILE (#2)
	156	S $P(^PSRX(PSOIEN,0),"^",3)=PNTSTAT ;RX PATIENT STATUS FILE (#53)
	157	S $P(^PSRX(PSOIEN,0),"^",4)=PROV ;NEW PERSON FILE (#200)
[1624]	158	S $P(^PSRX(PSOIEN,0),"^",5)=$$HL^C0XPT0() ; Outpatient ; LOC ;HOSPITAL LOCATION FILE (#44); Default smart location
[1607]	159	S $P(^PSRX(PSOIEN,0),"^",6)=PSODRUG ;POINTER TO DRUG FILE (#50)
	160	S $P(^PSRX(PSOIEN,0),"^",7)=QTY ;NUMBER ;0;7 NUMBER (Required)
	161	S $P(^PSRX(PSOIEN,0),"^",8)=DAYSUPLY ;NUMBER ; 0;8 NUMBER (Required)
	162	S $P(^PSRX(PSOIEN,0),"^",9)=REFIL ;NUMBER ; 0;9 NUMBER (Required)
	163	S $P(^PSRX(PSOIEN,0),"^",11)=MLWIND ;'M' or 'W'
	164	S $P(^PSRX(PSOIEN,0),"^",16)=ENTERBY ;NEW PERSON FILE (#200)
	165	S $P(^PSRX(PSOIEN,0),"^",17)=UNITPRICE ;NUMBER
	166	S $P(^PSRX(PSOIEN,0),"^",18)=COPIES ;COPIES
	167	;
	168	S $P(^PSRX(PSOIEN,2),"^",1)=LOGDT ;LOGIN DATE ; 2;1 DATE (Required)
	169	S $P(^PSRX(PSOIEN,2),"^",2)=FILLDT ;FILL DATE
	170	;S $P(^PSRX(PSOIEN,2),"^",3)=PHARMACIST ; "" ; PHARMACIST ;2;3 POINTER TO NEW PERSON FILE (#200)
	171	;S $P(^PSRX(PSOIEN,2),"^",4)="" ; LOT # 2;4 FREE TEXT
	172	S $P(^PSRX(PSOIEN,2),"^",5)=DISPDT ; DISPENSED DATE 2;5 DATE (Required)
	173	S $P(^PSRX(PSOIEN,2),"^",6)=EXPIRDT ;"" ; EXPIRATION DATE
	174	S $P(^PSRX(PSOIEN,2),"^",9)=PSOSITE ;2;9 POINTER TO OUTPATIENT SITE FILE (#59)
	175	;
	176	S $P(^PSRX(PSOIEN,3),U,1)=DISPDT ;LAST DISPENSED DATE 3;1 DATE
[1624]	177	S $P(^PSRX(PSOIEN,3),U,7)="Imported from Smart" ; REMARKS FT
[1607]	178	;
[1624]	179	S $P(^PSRX(PSOIEN,"EPH"),U,1)=0 ; DAW Code
	180	;
[1613]	181	N C0XFILL S C0XFILL=""
	182	N C0XREFCT S C0XREFCT=0
	183	F S C0XFILL=$O(FILLS(RXN,C0XFILL)) Q:C0XFILL="" D
	184	. S ^PSRX(PSOIEN,"A",0)="^52.3DA"_U_(C0XREFCT+1)_U_(C0XREFCT+1)
	185	. S $P(^PSRX(PSOIEN,"A",C0XREFCT+1,0),"^",1)=LOGDT ;DATE
	186	. S $P(^PSRX(PSOIEN,"A",C0XREFCT+1,0),"^",2)="N" ;SET ; Dispensed using external interface
	187	. S $P(^PSRX(PSOIEN,"A",C0XREFCT+1,0),"^",3)=INIT ;NEW PERSON FILE (#200)
	188	. S $P(^PSRX(PSOIEN,"A",C0XREFCT+1,0),"^",4)=0 ;NUMBER - RX REFERENCE
[1616]	189	. S $P(^PSRX(PSOIEN,"A",C0XREFCT+1,0),"^",5)="Imported from Smart"
[1613]	190	. ;
	191	. Q:C0XFILL=FILDT ; Don't add refill data for first fill!
	192	. ;
	193	. ; Increment counter
	194	. S C0XREFCT=C0XREFCT+1
	195	. ;
	196	. S ^PSRX(PSOIEN,1,0)="^52.1DA"_U_(C0XREFCT)_U_(C0XREFCT)
	197	. S $P(^PSRX(PSOIEN,1,C0XREFCT,0),"^",1)=C0XFILL ; REFILL DATE [D]
	198	. S $P(^PSRX(PSOIEN,1,C0XREFCT,0),"^",2)=MLWIND ; MAIL/WINDOW [RS]
	199	. S $P(^PSRX(PSOIEN,1,C0XREFCT,0),"^",3)="Imported from Smart" ; REMARKS [F]
	200	. S $P(^PSRX(PSOIEN,1,C0XREFCT,0),"^",4)=FILLS(RXN,C0XFILL,"sp:quantityDispensed.sp:value") ; QTY [RNJ12,2X]
	201	. S $P(^PSRX(PSOIEN,1,C0XREFCT,0),"^",5)=.5 ; PHARMACIST NAME [*P200']
	202	. S $P(^PSRX(PSOIEN,1,C0XREFCT,0),"^",6)="" ; LOT [F]
	203	. S $P(^PSRX(PSOIEN,1,C0XREFCT,0),"^",7)=.5 ; CLERK CODE [RP200']
	204	. S $P(^PSRX(PSOIEN,1,C0XREFCT,0),"^",8)="" ; LOGIN DATE [D]
	205	. S $P(^PSRX(PSOIEN,1,C0XREFCT,0),"^",9)="" ; DIVISION [RP59']
	206	. S $P(^PSRX(PSOIEN,1,C0XREFCT,0),"^",17)=PROV ; PROVIDER [R*P200X'I]
	207	. S $P(^PSRX(PSOIEN,1,C0XREFCT,0),"^",19)=C0XFILL ; DISPENSED DATE [RD]
[1607]	208	;
	209	S ^PSRX(PSOIEN,"OR1")=PORDITM ;PHARMACY ORDERABLE ITEM FILE (#50.7)
[1624]	210	S $P(^PSRX(PSOIEN,"OR1"),U,5)=.5 ; Finishing Person
	211	S $P(^PSRX(PSOIEN,"OR1"),U,8)=$$NOW^XLFDT() ; Finish Date/Time; seconds required.
[1607]	212	;
	213	;
	214	S $P(^PSRX(PSOIEN,"SIG"),"^",1)=SIG ;SIG;1 FREE TEXT (Required) medication instruction DIC(51)
	215	S $P(^PSRX(PSOIEN,"SIG"),"^",2)=0 ;OERR SIG (SET: 0 for NO; 1 for YES)
	216	;
	217	S $P(^PSRX(PSOIEN,"STA"),"^",1)=STATUS ;STA;1 SET (Required) ; '0' FOR ACTIVE;
	218	;
	219	;S ^PSRX(PSOIEN,"IB")=TRNSTYP ;COPAY TRANSACTION TYPE IB ACTION TYPE FILE (#350.1)
[1608]	220	S ^PSRX(PSOIEN,"TYPE")=0 ;TYPE OF RX TYPE;1 NUMBER
[1624]	221	;
[1613]	222	D OERR(PSOIEN),F55,F52(PSOIEN),F525
[1624]	223	;
[1609]	224	L -PSRX(PSOIEN) ; Unlock record
[1607]	225	Q
	226	;
[1609]	227	OERR(PSOIEN) ;UPDATES OR1 NODE
[1607]	228	;THE SECOND PIECE IS KILLED BEFORE MAKING THE CALL
	229	S $P(^PSRX(PSOIEN,"OR1"),"^",2)=""
[1609]	230	N PSXRXIEN,STAT,PSSTAT,COMM,PSNOO
[1607]	231	S PSXRXIEN=PSOIEN,STAT="SN",PSSTAT="CM",COMM="",PSNOO="W"
	232	D EN^PSOHLSN1(PSXRXIEN,STAT,PSSTAT,COMM,PSNOO)
[1609]	233	QUIT
[1607]	234	F55 ; - File data into ^PS(55)
	235	;S PSODFN=DFN
	236	S:'$D(^PS(55,PSODFN,"P",0)) ^(0)="^55.03PA^^"
	237	F PSOX1=$P(^PS(55,PSODFN,"P",0),"^",3):1 Q:'$D(^PS(55,PSODFN,"P",PSOX1))
	238	S ^PS(55,PSODFN,"P",PSOX1,0)=PSOIEN,$P(^PS(55,PSODFN,"P",0),"^",3,4)=PSOX1_"^"_($P(^PS(55,PSODFN,"P",0),"^",4)+1)
[1609]	239	S:$P($G(^PSRX(PSOIEN,2)),"^",6) ^PS(55,PSODFN,"P","A",$P($G(^PSRX(PSOIEN,2)),"^",6),PSOIEN)=""
[1607]	240	K PSOX1
	241	Q
[1613]	242	F52(PSOIEN) ;; - Re-indexing file 52 entry
	243	N DIK,DA S DIK="^PSRX(",DA=PSOIEN D IX1^DIK K DIK
[1607]	244	Q
	245	;
	246	F525 ;UPDATE SUSPENSE FILE
	247	Q:$G(^PSRX(PSOIEN,"STA"))'=5
	248	S DA=PSOIEN,X=PSOIEN,FDT=$P($G(^PSRX(PSOIEN,2)),"^",2),TYPE=$P($G(^PSRX(PSOIEN,0)),"^",11)
	249	S DIC="^PS(52.5,",DIC(0)="L",DLAYGO=52.5,DIC("DR")=".02///"_FDT_";.03////"_$P(^PSRX(PSOIEN,0),"^",2)_";.04////"_TYPE_";.05///0;.06////"_DIV_";2///0" K DD,D0 D FILE^DICN K DD,D0
	250	Q

Note: See TracBrowser for help on using the repository browser.

Context Navigation

source: fmts/trunk/p/C0XPT3.m@ 1669

Download in other formats: