- Timestamp:
- Feb 21, 2013, 7:57:31 PM (11 years ago)
- Location:
- fmts/trunk/p
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
fmts/trunk/p/C0XGET3.m
r1604 r1609 1 C0XGET3 ; VEN/SMH - Sam's Getters... let's try to make them simple ;2013-02- 04 12:00 PM1 C0XGET3 ; VEN/SMH - Sam's Getters... let's try to make them simple ;2013-02-20 11:50 AM 2 2 ;;1.1;FILEMAN TRIPLE STORE; 3 3 ; … … 33 33 Q:$L(EP) $$GSPO1(G,O,EP) ; if we have an extended predicate, recurse 34 34 Q ^C0X(201,O,0) ; this is the end point of the recursion. 35 ; 36 GSPO(R,G,S,P) ; Public Proc; Get Objects for a Graph/Subject/Predicate combination 37 ; Supports forward relational navigation for predicates using "." as separator 38 ; R is global style RPC reference 39 ; Extended Predicates are assumed to have only one object 40 ; This routine doesn't process multiple objects for the extended predicate. 41 N EP S EP=$P(P,".",2,99) ; Extended Predicate 42 S P=$P(P,".") ; Predicate becomes the first piece 43 N O S O="" 44 F S O=$O(^C0X(101,"GSPO",$$IEN(G),$$IEN(S),$$IEN(P),O)) Q:O="" D ; For each object 45 . I $L(EP) D ; If we have an extended predicate... 46 . . 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 47 . . . S @R@(O,$$NSP^C0XUTIL(P))=$$GSPO1(G,O,P) ; Return (Object, namespaced predicate)=value 48 . . E S @R@(O)=$$GSPO1(G,O,EP) ; If Extended Predicate, resolve the predicate to get ultimate object 49 . E S @R@(O)=^C0X(201,O,0) ; Otherwise, just return the object 50 QUIT -
fmts/trunk/p/C0XPT0.m
r1607 r1609 1 C0XPT0 ; VEN/SMH - Get patient data and do something about it ;2013-02- 19 2:14PM1 C0XPT0 ; VEN/SMH - Get patient data and do something about it ;2013-02-21 4:52 PM 2 2 ;;1.1;FILEMAN TRIPLE STORE;; 3 3 ; … … 5 5 NEW RETURN 6 6 DO GRAPHS^C0XGET1(.RETURN) ; TODO: Return could be a global due to large data. 7 N I S I="" F S I=$O(RETURN(I)) Q:I="" D ; For each IEN8 . N G S G="" F S G=$O(RETURN( I,G)) Q:G="" D ; For each graph tied to IEN7 N C0XI S C0XI="" F S C0XI=$O(RETURN(C0XI)) Q:C0XI="" D ; For each IEN 8 . N G S G="" F S G=$O(RETURN(C0XI,G)) Q:G="" D ; For each graph tied to IEN 9 9 . . D PROGRAPH(G) ; Process Graph 10 10 QUIT -
fmts/trunk/p/C0XPT3.m
r1608 r1609 1 C0XPT3 ;ISI/MLS,VEN/SMH -- MEDS IMPORT ;2013-02-20 3:15 PM1 C0XPT3 ;ISI/MLS,VEN/SMH -- MEDS IMPORT ;2013-02-21 5:05 PM 2 2 ;;1.0;FILEMAN TRIPLE STORE;;Jun 26,2012;Build 29 3 3 ; … … 8 8 ; 9 9 ; For each medication (I = COUNTER; S = Medication Node as Subject) 10 N I,S F I=0:0 S I=$O(^TMP($J,"MEDS",I)) Q:'I S S=^(I) DO MED1(G,S) 11 ; 10 N C0XI,S F C0XI=0:0 S C0XI=$O(^TMP($J,"MEDS",C0XI)) Q:'C0XI S S=^(C0XI) DO MED1(G,S,DFN) 12 11 K ^TMP($J,"MEDS") 13 12 QUIT 14 13 ; 15 MED1(G,S ) ; Private Procedure; Process each medication in Graph.14 MED1(G,S,DFN) ; Private Procedure; Process each medication in Graph. 16 15 ; G = Graph; S = Medication Description ID as subject. 17 16 ; … … 62 61 . S FILLS(RXN,FILLDATE,"sp:quantityDispensed.sp:unit")=$TR($$GSPO1^C0XGET3(G,S,"sp:quantityDispensed.sp:unit"),"{}") 63 62 ; 64 ZWRITE:$D(FILLS) FILLS 63 ; ZWRITE:$D(FILLS) FILLS 64 ; 65 D 66 . N FILDT,FILQTY,FILDAYS 67 . S FILDT=$O(FILLS(RXN,"")) 68 . I FILDT S FILQTY=FILLS(RXN,FILDT,"sp:quantityDispensed.sp:value"),FILDAYS=FILLS(RXN,FILDT,"sp:dispenseDaysSupply") 69 . E S (FILQTY,FILDAYS)="" 70 . D PREP(DFN,RXN,INST,FILDT,FILQTY,FILDAYS) 71 ; 65 72 QUIT 73 PREP(DFN,RXN,INST,FILDT,FILQTY,FILDAYS) ; 74 N ORZPT,PSODFN S (ORZPT,PSODFN)=DFN ;"" ;POINTER TO PATIENT FILE (#2) 75 N PNTSTAT S PNTSTAT=20 ; NON-VA ;RX PATIENT STATUS FILE (#53) 76 N PROV S PROV=$$NP^C0XPT0() ;NEW PERSON FILE (#200) 77 N PSODRUG S PSODRUG=94558 ;POINTER TO DRUG FILE (#50) ; TODO: HARDCODED; RXN 78 S PSODRUG("DEA")=$P($G(^PSDRUG(PSODRUG,0)),U,3) 79 N QTY S QTY=FILQTY ; NUMBER ;0;7 NUMBER (Required) 80 N DAYSUPLY S DAYSUPLY=FILDAYS ;NUMBER ; 0;8 NUMBER (Required); 81 N REFIL S REFIL=0 ;NUMBER ; 0;9 NUMBER (Required) 82 N ORDCONV S ORDCONV=1 ;'1' FOR ORDER CONVERTED;'2' FOR EXPIRATION TO CPRS; 83 N COPIES S COPIES=1 ;NUMBER 84 N MLWIND S MLWIND="W" ; Mail/Window: 'M' or 'W' 85 N ENTERBY S ENTERBY=.5 ;NEW PERSON FILE (#200) - POSTMASTER 86 N UNITPRICE S UNITPRICE=$P(^PSDRUG(PSODRUG,660),U,6) ;0.009 ;"" ;NUMBER 87 N PSOSITE S PSOSITE=$O(^PS(59,0)) ; OUTPATIENT SITE FILE (#59); get first one 88 N %,LOGDT D NOW^%DTC S LOGDT=% ;LOGIN DATE ; 2;1 DATE (Required) 89 N FILLDT S FILLDT=FILDT ;DATE; First fill date from our data. 90 N ISSDT S ISSDT=FILLDT ;DATE 91 N DISPDT S DISPDT=ISSDT ;DATE 92 N X D 93 . N X1,X2 94 . S X1=DISPDT,X2=180 D C^%DTC ;Default expiration of T+180 95 N EXPIRDT S EXPIRDT=X ; 96 N PORDITM S PORDITM=$P($G(^PSDRUG(PSODRUG,2)),U,1) ;PHARMACY ORDERABLE ITEM FILE (#50.7) 97 N STATUS S STATUS=0 ;STA;1 SET (Required) ; '0' FOR ACTIVE; 98 N TRNSTYP S TRNSTYP=1 ; IB ACTION TYPE FILE (#350.1) 99 N LDISPDT S LDISPDT=FILLDT ; 3;1 DATE 100 N REASON S REASON="E" ;Activity log ; SET ([E]dit) 101 N INIT S INIT=DUZ ;NEW PERSON FILE (#200) 102 N COM S COM="Oupatient medication order." ;TEXT 103 N SIG S SIG=INST ;#51,.01 66 104 ; 67 MED(ISIMISC) ;Create med order entry 68 ; Input - ISIMISC(ARRAY) 69 ; Format: ISIMISC(PARAM)=VALUE 70 ; eg: ISIMISC("DFN")=123455 105 CREATE ; fall through 71 106 ; 72 ; Output - ISIRC [return code] 73 ; ISIRESUL(0)=1 [if successful] 74 ; ISIRESUL(1)=PSOIEN [if successful] 107 N PSONEW 108 D AUTO^PSONRXN ;RX auto number 109 I $G(PSONEW("RX #"))="" S $EC=",U1," ; Auto-numbering not turned on! 110 N RXNUM S RXNUM=PSONEW("RX #") ; Rx Number, again... 75 111 ; 76 N ORZPT,PNTSTAT,PROV,PSODRUG,QTY,DAYSUPLY,REFIL,ORDCONV,RXNUM,PSOIEN 77 N COPIES,MLWIND,ENTERBY,UNITPRICE,PSOSITE,LOGDT,DISPDT,ISSDT,SIG 78 N X1,X2,EXPIRDT,STATUS,TRNSTYP,LDISPDT,FILLDT,PORDITM,REASON 79 N INIT,COM 112 L +^PSRX(0):0 ; Lock zero node while we get the record. 113 N PSOIEN S PSOIEN=$P($G(^PSRX(0)),"^",3)+1 ; Next available IEN 114 I $D(^PSRX(PSOIEN)) S $EC=",U1," ; Next number not available. File issue. 115 S $P(^PSRX(0),U,3)=PSOIEN ; Reset next available number. 116 S $P(^PSRX(PSOIEN,0),"^",1)=RXNUM ; 0;1 FREE TEXT (Required) 117 L -^PSRX(0) ; Unlock zero node, we now got it 80 118 ; 81 S ISIRC=1 82 D PREP 83 I +ISIRC<0 Q ISIRC 84 D CREATE 85 I +ISIRC<0 Q ISIRC 86 S ISIRESUL(0)=1 87 S ISIRESUL(1)=PSOIEN 88 Q ISIRC 89 ; 90 PREP ; 91 ; 92 N EXIT 93 S ORZPT=ISIMISC("DFN") ;"" ;POINTER TO PATIENT FILE (#2) 94 S PSODFN=ORZPT 95 S PNTSTAT=20 ; NON-VA ;RX PATIENT STATUS FILE (#53) 96 S PROV=ISIMISC("PROV") ;NEW PERSON FILE (#200) 97 S PSODRUG=ISIMISC("DRUG") ;"" ;POINTER TO DRUG FILE (#50) 98 S PSODRUG("DEA")=$P($G(^PSDRUG(PSODRUG,0)),U,3) 99 S QTY=ISIMISC("QTY") ;NUMBER ;0;7 NUMBER (Required) 100 S DAYSUPLY=ISIMISC("SUPPLY") ;NUMBER ; 0;8 NUMBER (Required) 101 S REFIL=ISIMISC("REFILL") ;NUMBER ; 0;9 NUMBER (Required) 102 S ORDCONV=1 ;'1' FOR ORDER CONVERTED;'2' FOR EXPIRATION TO CPRS; 103 S COPIES=1 ;NUMBER 104 S MLWIND="W" ;'M' or 'W' 105 S ENTERBY=DUZ ;NEW PERSON FILE (#200) 106 S UNITPRICE=$P(^PSDRUG(PSODRUG,660),U,6) ;0.009 ;"" ;NUMBER 107 S PSOSITE=ISIMISC("PSOSITE") ; OUTPATIENT SITE FILE (#59) 108 D NOW^%DTC S LOGDT=% ;LOGIN DATE ; 2;1 DATE (Required) 109 S FILLDT=ISIMISC("DATE") ;DATE 110 S ISSDT=FILLDT ;DATE 111 S DISPDT=ISSDT ;DATE 112 S X1=DISPDT,X2=180 D C^%DTC ;Default expiration of T+180 113 S EXPIRDT=X ; 114 S PORDITM=$P($G(^PSDRUG(PSODRUG,2)),U,1) ;PHARMACY ORDERABLE ITEM FILE (#50.7) 115 S STATUS=0 ;STA;1 SET (Required) ; '0' FOR ACTIVE; 116 S TRNSTYP=1 ; IB ACTION TYPE FILE (#350.1) 117 S LDISPDT=FILLDT ; 3;1 DATE 118 S REASON="E" ;Activity log ; SET ([E]dit) 119 S INIT=DUZ ;NEW PERSON FILE (#200) 120 S COM="Oupatient medication order." ;TEXT 121 S SIG=ISIMISC("SIG") ;#51,.01 122 Q 123 ; 124 CREATE ; 125 D AUTO^PSONRXN ;RX auto number 126 I $G(PSONEW("RX #"))="" S ISIRC="-1^RX Auto number error." Q 127 S RXNUM=PSONEW("RX #") 128 ; 129 S PSOIEN=$P($G(^PSRX(0)),"^",3)+1 130 I $D(^PSRX(PSOIEN)) S ISIRC="-1^Problem with PSRX (#50) internal counter" Q ;pointer error 131 S $P(^PSRX(0),U,3)=PSOIEN 132 ; 133 S $P(^PSRX(PSOIEN,0),"^",1)=RXNUM ; 0;1 FREE TEXT (Required) 119 L +^PSRX(PSOIEN):0 ; Lock record node 134 120 S $P(^PSRX(PSOIEN,0),"^",13)=ISSDT ; 0;13 DATE (Required) 135 121 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) 176 162 S ^PSRX(PSOIEN,"TYPE")=0 ;TYPE OF RX TYPE;1 NUMBER 177 D OERR,F55,F52,F525 163 D OERR(PSOIEN),F55,F52,F525 164 L -PSRX(PSOIEN) ; Unlock record 178 165 Q 179 166 ; 180 OERR ;UPDATES OR1 NODE167 OERR(PSOIEN) ;UPDATES OR1 NODE 181 168 ;THE SECOND PIECE IS KILLED BEFORE MAKING THE CALL 182 169 S $P(^PSRX(PSOIEN,"OR1"),"^",2)="" 170 N PSXRXIEN,STAT,PSSTAT,COMM,PSNOO 183 171 S PSXRXIEN=PSOIEN,STAT="SN",PSSTAT="CM",COMM="",PSNOO="W" 184 172 D EN^PSOHLSN1(PSXRXIEN,STAT,PSSTAT,COMM,PSNOO) 173 QUIT 185 174 F55 ; - File data into ^PS(55) 186 175 ;S PSODFN=DFN … … 188 177 F PSOX1=$P(^PS(55,PSODFN,"P",0),"^",3):1 Q:'$D(^PS(55,PSODFN,"P",PSOX1)) 189 178 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) 190 S ^PS(55,PSODFN,"P","A",$P($G(^PSRX(PSOIEN,2)),"^",6),PSOIEN)=""179 S:$P($G(^PSRX(PSOIEN,2)),"^",6) ^PS(55,PSODFN,"P","A",$P($G(^PSRX(PSOIEN,2)),"^",6),PSOIEN)="" 191 180 K PSOX1 192 181 Q
Note:
See TracChangeset
for help on using the changeset viewer.
