source: qrda/C0Q/trunk/p/C0QIMMUN.m@ 1230

Last change on this file since 1230 was 1230, checked in by George Lilly, 13 years ago

update instead of delete old patient lists for performance

File size: 2.1 KB
Line 
1C0QIMMUN ;Prep Immunization Order data for HL7 Message creation ;
2 ;;0.1;C0Q;nopatch;noreleasedate;Build 14
3 ; ^XTMP("C0QIMMUN",0)=purge date^create date
4 ; ^XTMP("C0QIMMUN",order_date,order#,item_name)=item_value
5 ; ^XTMP("C0QIMMUN","LASTORDR")=last order processed
6FIND ; Find the next set of immunization orders
7 N X1,X2,X,%,%DT,%H,%T,NOW,ORDER,LASTORDR,SUBSC,DIR
8 S LASTORDR=+$G(^XTMP("C0QIMMUN","LASTORDR"))
9 W !,"The ""Last Order"" from which to begin checking for Immunization orders is: ",LASTORDR
10 S DIR("A")="Do you want to reset that value"
11 S DIR(0)="Y",DIR("B")="NO" D ^DIR D:Y=1
12 . S DIR("A")="What value shall be used?"
13 . S DIR(0)="NO",DIR("B")=LASTORDR D ^DIR
14 . W:Y'>0 !,"We'll skip reseting it then."
15 . D:Y>0
16 . . S LASTORDR=+Y
17 . . L +^XTMP("C0QIMMUN")
18 . . S X1=DT,X2=365 D C^%DTC
19 . . S ^XTMP("C0QIMMUN",0)=X_U_DT
20 . . S ^XTMP("C0QIMMUN","LASTORDR")=LASTORDR
21 . . L -^XTMP("C0QIMMUN")
22 . . Q
23 . Q
24 S DIR("A")="Ready to prep more immunization orders for HL7 messages"
25 S DIR(0)="Y",DIR("B")="YES" D ^DIR Q:Y'=1
26 L +^XTMP("C0QIMMUN")
27 I '$D(^XTMP("C0QIMMUN",0)) D
28 . S X1=DT,X2=365 D C^%DTC
29 . S ^XTMP("C0QIMMUN",0)=X_U_DT
30 . S ^XTMP("C0QIMMUN","LASTORDR")=0
31 S ORDER=^XTMP("C0QIMMUN","LASTORDR")
32 F S ORDER=$O(^OR(100,ORDER)) Q:ORDER'>0 D
33 . S LASTORDR=ORDER
34 . D:$D(^OR(100,ORDER,4.5,"ID","ORZ HL7")) GOTONE
35 . Q
36 S ^XTMP("C0QIMMUN","LASTORDR")=LASTORDR
37 W !,"Done",!,"Last Order processed: ",LASTORDR,!
38 L -^XTMP("C0QIMMUN")
39 Q
40GOTONE ; Take the order number and move the relevant HL7 information into ^XTMP
41 S NOW=$P(^OR(100,ORDER,0),U,7)
42 S ^XTMP("C0QIMMUN",NOW,ORDER,"PATIENT")=$P(^OR(100,ORDER,0),U,2)
43 S ^XTMP("C0QIMMUN",NOW,ORDER,"LOCATION")=$P(^OR(100,ORDER,0),U,10)
44 S ^XTMP("C0QIMMUN",NOW,ORDER,"ORDEREDBY")=$P(^OR(100,ORDER,0),U,6)
45 S ENTRY=0 F S ENTRY=$O(^OR(100,ORDER,4.5,ENTRY)) Q:ENTRY'>0 D
46 . S SUBSC=$P($G(^OR(100,ORDER,4.5,ENTRY,0)),U,4)
47 . Q:'$L(SUBSC)
48 . I SUBSC'="TIME" S ^XTMP("C0QIMMUN",NOW,ORDER,SUBSC)=^OR(100,ORDER,4.5,ENTRY,1)
49 . E S X=^OR(100,ORDER,4.5,ENTRY,1),%DT="TS" D ^%DT S ^XTMP("C0QIMMUN",NOW,ORDER,SUBSC)=Y
50 . Q
51 S ^XTMP("C0QIMMUN",NOW,ORDER,"ORDERTEXT")=$G(^OR(100,ORDER,8,1,.1,1,0))
52 Q
Note: See TracBrowser for help on using the repository browser.