Changeset 1609

Timestamp:

Feb 21, 2013, 7:57:31 PM (12 years ago)

Author:

Sam Habiel

Message:

Medications: Can now add a fake prescription to the record

Location:

fmts/trunk/p

Files:

• C0XGET3.m (modified) (2 diffs)
• C0XPT0.m (modified) (2 diffs)
• C0XPT3.m (modified) (5 diffs)

fmts/trunk/p/C0XGET3.m

@@ -1 @@
-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;
  ;
@@ -33 +33 @@
  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

fmts/trunk/p/C0XPT0.m

@@ -1 @@
-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;;
  ;
@@ -5 +5 @@
  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

fmts/trunk/p/C0XPT3.m

@@ -1 @@
-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
         ;
@@ -8 +8 @@
         ;
         ; 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.
         ;
@@ -62 +61 @@
         . 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
+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)
+        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
         ;
-MED(ISIMISC)    ;Create med order entry
-        ; Input - ISIMISC(ARRAY)
-        ; Format:  ISIMISC(PARAM)=VALUE
-        ;     eg:  ISIMISC("DFN")=123455 
+CREATE ; fall through
         ;
-        ; Output - ISIRC [return code]
-        ;          ISIRESUL(0)=1 [if successful]
-        ;          ISIRESUL(1)=PSOIEN [if successful] 
+        N PSONEW
+        D AUTO^PSONRXN ;RX auto number
+        I $G(PSONEW("RX #"))="" S $EC=",U1," ; Auto-numbering not turned on!
+        N RXNUM S RXNUM=PSONEW("RX #") ; Rx Number, again...
         ;
-        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
+        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
         ;
-        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)
-        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
-        ;
-CREATE ;
-        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
-        ;
-        S $P(^PSRX(PSOIEN,0),"^",1)=RXNUM ; 0;1 FREE TEXT (Required)
+        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)
@@ -175 +161 @@
         ;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
@@ -188 +177 @@
         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