iSharkFly-Open
/
VistA-fmts
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Medications: Can now add a fake prescription to the record

This commit is contained in:
sam 2013-02-22 00:57:31 +00:00
parent f95d8d48db
commit d774bbd6b3
3 changed files with 80 additions and 75 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
p/C0XGET3.m
View File

@ -1,4 +1,4 @@
C0XGET3 ; VEN/SMH - Sam's Getters... let's try to make them simple ;2013-02-04 12:00 PM
C0XGET3 ; VEN/SMH - Sam's Getters... let's try to make them simple ;2013-02-20 11:50 AM
;;1.1;FILEMAN TRIPLE STORE;
;
IEN(N) ; Public $$; Resolved IEN of a stored string such as "rdf:type" in Strings File
@ -32,3 +32,19 @@ GSPO1(G,S,P) ; Public $$; Get Object for A Graph/Subject/Predicate combination
Q:O="" "" ; Another end point for recursion
Q:$L(EP) $$GSPO1(G,O,EP) ; if we have an extended predicate, recurse
Q ^C0X(201,O,0) ; this is the end point of the recursion.
;
GSPO(R,G,S,P) ; Public Proc; Get Objects for a Graph/Subject/Predicate combination
; Supports forward relational navigation for predicates using "." as separator
; R is global style RPC reference
; Extended Predicates are assumed to have only one object
; This routine doesn't process multiple objects for the extended predicate.
N EP S EP=$P(P,".",2,99) ; Extended Predicate
S P=$P(P,".") ; Predicate becomes the first piece
N O S O=""
F S O=$O(^C0X(101,"GSPO",$$IEN(G),$$IEN(S),$$IEN(P),O)) Q:O="" D ; For each object
. I $L(EP) D ; If we have an extended predicate...
. . I EP="*" N P S P="" F S P=$O(^C0X(101,"GSPO",$$IEN(G),$$IEN(O),P)) Q:P="" D ; If all predicates (EP=*) for each predicate
. . . S @R@(O,$$NSP^C0XUTIL(P))=$$GSPO1(G,O,P) ; Return (Object, namespaced predicate)=value
. . E S @R@(O)=$$GSPO1(G,O,EP) ; If Extended Predicate, resolve the predicate to get ultimate object
. E S @R@(O)=^C0X(201,O,0) ; Otherwise, just return the object
QUIT

6
p/C0XPT0.m
View File

@ -1,11 +1,11 @@
C0XPT0 ; VEN/SMH - Get patient data and do something about it ;2013-02-19 2:14 PM
C0XPT0 ; VEN/SMH - Get patient data and do something about it ;2013-02-21 4:52 PM
;;1.1;FILEMAN TRIPLE STORE;;
;
; Get all graphs
NEW RETURN
DO GRAPHS^C0XGET1(.RETURN) ; TODO: Return could be a global due to large data.
N I S I="" F S I=$O(RETURN(I)) Q:I="" D ; For each IEN
. N G S G="" F S G=$O(RETURN(I,G)) Q:G="" D ; For each graph tied to IEN
N C0XI S C0XI="" F S C0XI=$O(RETURN(C0XI)) Q:C0XI="" D ; For each IEN
. N G S G="" F S G=$O(RETURN(C0XI,G)) Q:G="" D ; For each graph tied to IEN
. . D PROGRAPH(G) ; Process Graph
QUIT
;

131
p/C0XPT3.m
View File

@ -1,4 +1,4 @@
C0XPT3 ;ISI/MLS,VEN/SMH -- MEDS IMPORT;2013-02-20 3:15 PM
C0XPT3 ;ISI/MLS,VEN/SMH -- MEDS IMPORT ;2013-02-21 5:05 PM
;;1.0;FILEMAN TRIPLE STORE;;Jun 26,2012;Build 29
;
MEDS(G,DFN) ; Private Proc; Extract Medication Data from a Patient's Graph
@ -7,12 +7,11 @@ MEDS(G,DFN) ; Private Proc; Extract Medication Data from a Patient's Graph
D ONETYPE^C0XGET3($NA(^TMP($J,"MEDS")),G,"sp:Medication")
;
; For each medication (I = COUNTER; S = Medication Node as Subject)
N I,S F I=0:0 S I=$O(^TMP($J,"MEDS",I)) Q:'I S S=^(I) DO MED1(G,S)
;
N C0XI,S F C0XI=0:0 S C0XI=$O(^TMP($J,"MEDS",C0XI)) Q:'C0XI S S=^(C0XI) DO MED1(G,S,DFN)
K ^TMP($J,"MEDS")
QUIT
;
MED1(G,S) ; Private Procedure; Process each medication in Graph.
MED1(G,S,DFN) ; Private Procedure; Process each medication in Graph.
; G = Graph; S = Medication Description ID as subject.
;
; 1. Start Date; obtain and then conv to fileman format
@ -61,76 +60,63 @@ MED1(G,S) ; Private Procedure; Process each medication in Graph.
. S FILLS(RXN,FILLDATE,"sp:quantityDispensed.sp:value")=$$GSPO1^C0XGET3(G,S,"sp:quantityDispensed.sp:value")
. S FILLS(RXN,FILLDATE,"sp:quantityDispensed.sp:unit")=$TR($$GSPO1^C0XGET3(G,S,"sp:quantityDispensed.sp:unit"),"{}")
;
ZWRITE:$D(FILLS) FILLS
; ZWRITE:$D(FILLS) FILLS
;
D
. N FILDT,FILQTY,FILDAYS
. S FILDT=$O(FILLS(RXN,""))
. I FILDT S FILQTY=FILLS(RXN,FILDT,"sp:quantityDispensed.sp:value"),FILDAYS=FILLS(RXN,FILDT,"sp:dispenseDaysSupply")
. E S (FILQTY,FILDAYS)=""
. D PREP(DFN,RXN,INST,FILDT,FILQTY,FILDAYS)
;
QUIT
;
MED(ISIMISC) ;Create med order entry
; Input - ISIMISC(ARRAY)
; Format: ISIMISC(PARAM)=VALUE
; eg: ISIMISC("DFN")=123455
;
; Output - ISIRC [return code]
; ISIRESUL(0)=1 [if successful]
; ISIRESUL(1)=PSOIEN [if successful]
;
N ORZPT,PNTSTAT,PROV,PSODRUG,QTY,DAYSUPLY,REFIL,ORDCONV,RXNUM,PSOIEN
N COPIES,MLWIND,ENTERBY,UNITPRICE,PSOSITE,LOGDT,DISPDT,ISSDT,SIG
N X1,X2,EXPIRDT,STATUS,TRNSTYP,LDISPDT,FILLDT,PORDITM,REASON
N INIT,COM
;
S ISIRC=1
D PREP
I +ISIRC<0 Q ISIRC
D CREATE
I +ISIRC<0 Q ISIRC
S ISIRESUL(0)=1
S ISIRESUL(1)=PSOIEN
Q ISIRC
;
PREP ;
;
N EXIT
S ORZPT=ISIMISC("DFN") ;"" ;POINTER TO PATIENT FILE (#2)
S PSODFN=ORZPT
S PNTSTAT=20 ; NON-VA ;RX PATIENT STATUS FILE (#53)
S PROV=ISIMISC("PROV") ;NEW PERSON FILE (#200)
S PSODRUG=ISIMISC("DRUG") ;"" ;POINTER TO DRUG FILE (#50)
PREP(DFN,RXN,INST,FILDT,FILQTY,FILDAYS) ;
N ORZPT,PSODFN S (ORZPT,PSODFN)=DFN ;"" ;POINTER TO PATIENT FILE (#2)
N PNTSTAT S PNTSTAT=20 ; NON-VA ;RX PATIENT STATUS FILE (#53)
N PROV S PROV=$$NP^C0XPT0() ;NEW PERSON FILE (#200)
N PSODRUG S PSODRUG=94558 ;POINTER TO DRUG FILE (#50) ; TODO: HARDCODED; RXN
S PSODRUG("DEA")=$P($G(^PSDRUG(PSODRUG,0)),U,3)
S QTY=ISIMISC("QTY") ;NUMBER ;0;7 NUMBER (Required)
S DAYSUPLY=ISIMISC("SUPPLY") ;NUMBER ; 0;8 NUMBER (Required)
S REFIL=ISIMISC("REFILL") ;NUMBER ; 0;9 NUMBER (Required)
S ORDCONV=1 ;'1' FOR ORDER CONVERTED;'2' FOR EXPIRATION TO CPRS;
S COPIES=1 ;NUMBER
S MLWIND="W" ;'M' or 'W'
S ENTERBY=DUZ ;NEW PERSON FILE (#200)
S UNITPRICE=$P(^PSDRUG(PSODRUG,660),U,6) ;0.009 ;"" ;NUMBER
S PSOSITE=ISIMISC("PSOSITE") ; OUTPATIENT SITE FILE (#59)
D NOW^%DTC S LOGDT=% ;LOGIN DATE ; 2;1 DATE (Required)
S FILLDT=ISIMISC("DATE") ;DATE
S ISSDT=FILLDT ;DATE
S DISPDT=ISSDT ;DATE
S X1=DISPDT,X2=180 D C^%DTC ;Default expiration of T+180
S EXPIRDT=X ;
S PORDITM=$P($G(^PSDRUG(PSODRUG,2)),U,1) ;PHARMACY ORDERABLE ITEM FILE (#50.7)
S STATUS=0 ;STA;1 SET (Required) ; '0' FOR ACTIVE;
S TRNSTYP=1 ; IB ACTION TYPE FILE (#350.1)
S LDISPDT=FILLDT ; 3;1 DATE
S REASON="E" ;Activity log ; SET ([E]dit)
S INIT=DUZ ;NEW PERSON FILE (#200)
S COM="Oupatient medication order." ;TEXT
S SIG=ISIMISC("SIG") ;#51,.01
Q
N QTY S QTY=FILQTY ; NUMBER ;0;7 NUMBER (Required)
N DAYSUPLY S DAYSUPLY=FILDAYS ;NUMBER ; 0;8 NUMBER (Required);
N REFIL S REFIL=0 ;NUMBER ; 0;9 NUMBER (Required)
N ORDCONV S ORDCONV=1 ;'1' FOR ORDER CONVERTED;'2' FOR EXPIRATION TO CPRS;
N COPIES S COPIES=1 ;NUMBER
N MLWIND S MLWIND="W" ; Mail/Window: 'M' or 'W'
N ENTERBY S ENTERBY=.5 ;NEW PERSON FILE (#200) - POSTMASTER
N UNITPRICE S UNITPRICE=$P(^PSDRUG(PSODRUG,660),U,6) ;0.009 ;"" ;NUMBER
N PSOSITE S PSOSITE=$O(^PS(59,0)) ; OUTPATIENT SITE FILE (#59); get first one
N %,LOGDT D NOW^%DTC S LOGDT=% ;LOGIN DATE ; 2;1 DATE (Required)
N FILLDT S FILLDT=FILDT ;DATE; First fill date from our data.
N ISSDT S ISSDT=FILLDT ;DATE
N DISPDT S DISPDT=ISSDT ;DATE
N X D
. N X1,X2
. S X1=DISPDT,X2=180 D C^%DTC ;Default expiration of T+180
N EXPIRDT S EXPIRDT=X ;
N PORDITM S PORDITM=$P($G(^PSDRUG(PSODRUG,2)),U,1) ;PHARMACY ORDERABLE ITEM FILE (#50.7)
N STATUS S STATUS=0 ;STA;1 SET (Required) ; '0' FOR ACTIVE;
N TRNSTYP S TRNSTYP=1 ; IB ACTION TYPE FILE (#350.1)
N LDISPDT S LDISPDT=FILLDT ; 3;1 DATE
N REASON S REASON="E" ;Activity log ; SET ([E]dit)
N INIT S INIT=DUZ ;NEW PERSON FILE (#200)
N COM S COM="Oupatient medication order." ;TEXT
N SIG S SIG=INST ;#51,.01
;
CREATE ;
CREATE ; fall through
;
N PSONEW
D AUTO^PSONRXN ;RX auto number
I $G(PSONEW("RX #"))="" S ISIRC="-1^RX Auto number error." Q
S RXNUM=PSONEW("RX #")
;
S PSOIEN=$P($G(^PSRX(0)),"^",3)+1
I $D(^PSRX(PSOIEN)) S ISIRC="-1^Problem with PSRX (#50) internal counter" Q ;pointer error
S $P(^PSRX(0),U,3)=PSOIEN
I $G(PSONEW("RX #"))="" S $EC=",U1," ; Auto-numbering not turned on!
N RXNUM S RXNUM=PSONEW("RX #") ; Rx Number, again...
;
L +^PSRX(0):0 ; Lock zero node while we get the record.
N PSOIEN S PSOIEN=$P($G(^PSRX(0)),"^",3)+1 ; Next available IEN
I $D(^PSRX(PSOIEN)) S $EC=",U1," ; Next number not available. File issue.
S $P(^PSRX(0),U,3)=PSOIEN ; Reset next available number.
S $P(^PSRX(PSOIEN,0),"^",1)=RXNUM ; 0;1 FREE TEXT (Required)
L -^PSRX(0) ; Unlock zero node, we now got it
;
L +^PSRX(PSOIEN):0 ; Lock record node
S $P(^PSRX(PSOIEN,0),"^",13)=ISSDT ; 0;13 DATE (Required)
S $P(^PSRX(PSOIEN,0),"^",2)=ORZPT ;POINTER TO PATIENT FILE (#2)
S $P(^PSRX(PSOIEN,0),"^",3)=PNTSTAT ;RX PATIENT STATUS FILE (#53)
@ -174,20 +160,23 @@ CREATE ;
;
;S ^PSRX(PSOIEN,"IB")=TRNSTYP ;COPAY TRANSACTION TYPE IB ACTION TYPE FILE (#350.1)
S ^PSRX(PSOIEN,"TYPE")=0 ;TYPE OF RX TYPE;1 NUMBER
D OERR,F55,F52,F525
D OERR(PSOIEN),F55,F52,F525
L -PSRX(PSOIEN) ; Unlock record
Q
;
OERR ;UPDATES OR1 NODE
OERR(PSOIEN) ;UPDATES OR1 NODE
;THE SECOND PIECE IS KILLED BEFORE MAKING THE CALL
S $P(^PSRX(PSOIEN,"OR1"),"^",2)=""
N PSXRXIEN,STAT,PSSTAT,COMM,PSNOO
S PSXRXIEN=PSOIEN,STAT="SN",PSSTAT="CM",COMM="",PSNOO="W"
D EN^PSOHLSN1(PSXRXIEN,STAT,PSSTAT,COMM,PSNOO)
QUIT
F55 ; - File data into ^PS(55)
;S PSODFN=DFN
S:'$D(^PS(55,PSODFN,"P",0)) ^(0)="^55.03PA^^"
F PSOX1=$P(^PS(55,PSODFN,"P",0),"^",3):1 Q:'$D(^PS(55,PSODFN,"P",PSOX1))
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)
S ^PS(55,PSODFN,"P","A",$P($G(^PSRX(PSOIEN,2)),"^",6),PSOIEN)=""
S:$P($G(^PSRX(PSOIEN,2)),"^",6) ^PS(55,PSODFN,"P","A",$P($G(^PSRX(PSOIEN,2)),"^",6),PSOIEN)=""
K PSOX1
Q
F52 ;; - Re-indexing file 52 entry