source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORY153.m@ 1757

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.4 KB
Line 
1ORY153 ;SLC/JLI Hep-C Post Init ; Feb 04, 2003@11:44:15
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**153**;Dec 17, 1997
3 ;
4PRE ;Pre-init
5 Q
6POST ;Post-init
7 N OLDVAL
8 S OLDVAL=""
9 S OLDVAL=$$GET^XPAR("SYS^PKG","ORHEPC ABNORMAL START",1,"I")
10 D MAIN
11 D:$L(OLDVAL) EN^XPAR("SYS","ORHEPC ABNORMAL START",1,OLDVAL)
12 D UDABS
13 D UDRPTS
14 D QUE ;rebuild ARS xref this version
15 Q
16 ;
17MAIN ; main (initial) parameter transport routine
18 K ^TMP($J,"XPARRSTR")
19 N ENT,IDX,ROOT,REF,VAL,I
20 S ROOT=$NAME(^TMP($J,"XPARRSTR")),ROOT=$E(ROOT,1,$L(ROOT)-1)_","
21LOAD ; load data into ^TMP (expects ROOT to be defined)
22 S I=1 F S REF=$T(DATA+I) Q:REF="" S VAL=$T(DATA+I+1) D
23 . S I=I+2,REF=$P(REF,";",3,999),VAL=$P(VAL,";",3,999)
24 . S @(ROOT_REF)=VAL
25 Q
26XX2 S IDX=0,ENT="PKG."_"ORDER ENTRY/RESULTS REPORTING"
27 F S IDX=$O(^TMP($J,"XPARRSTR",IDX)) Q:'IDX D
28 . N PAR,INST,VAL,ERR
29 . S PAR=$P(^TMP($J,"XPARRSTR",IDX,"KEY"),U),INST=$P(^("KEY"),U,2)
30 . M VAL=^TMP($J,"XPARRSTR",IDX,"VAL")
31 . D EN^XPAR(ENT,PAR,INST,.VAL,.ERR)
32 K ^TMP($J,"XPARRSTR")
33 Q
34 ;
35UDABS ;Update abnormal result start date PKG level to installation date
36 ;update date range in abnormal result report
37 D EN^XPAR("PKG","ORHEPC ABNORMAL START",1,$$DT^XLFDT())
38 N DRANGEID,ABSID,STDT,IX,SD,TD,TXTC,DIFF
39 S (IX,ABSID,STDT,SD,TX,JX,DIFF)=0,TXTC=""
40 S ABSID=$O(^ORD(102.21,"B","RPT ABNORMAL RESULTS",0))
41 S DRANGEID=$O(^ORD(102.21,"B","CTP SEARCH DATE RANGE",0))
42 S STDT=$$GET^XPAR("SYS^PKG","ORHEPC ABNORMAL START",1,"I")
43 S TD=$$DT^XLFDT()
44 S DIFF=$$FMDIFF^XLFDT(STDT,TD,1)
45 S DIFF=+$FN(DIFF,"T")
46 I DIFF>184 S STDT="T-184"
47 S SD=$$FMTE^XLFDT(STDT)
48 S TD=$$FMTE^XLFDT(TD)
49 S TXTC="from "_SD_" through "_TD
50 F S IX=$O(^ORD(102.21,ABSID,1,IX)) Q:('IX)!JX D
51 . I $P(^ORD(102.21,ABSID,1,IX,0),U,2)=DRANGEID D
52 . . S $P(^ORD(102.21,ABSID,1,IX,0),U,4)=TXTC
53 . . S ^ORD(102.21,ABSID,1,IX,1,1,0)=STDT_":T"
54 . . K ^ORD(102.21,ABSID,1,IX,1,"B")
55 . . S ^ORD(102.21,ABSID,1,IX,1,"B",STDT_":T",1)="",JX=1 Q
56 Q
57UDRPTS ;
58CSLTRPT ;
59 N IX,JX,RPTID,CTGVL
60 S (IX,JX,RPTID,CTGVL)=0
61 S RPTID=$O(^ORD(102.21,"B","RPT CONSULT FOLLOW-UP",0))
62 F S IX=$O(^ORD(102.21,RPTID,1,IX)) Q:('IX)!JX D
63 . I $P(^(IX,0),U,4)="ALL SERVICES" D
64 . . S CTGVL=$O(^ORD(100.98,"B","CSLT",0))
65 . . S ^ORD(102.21,RPTID,1,IX,1,1,0)=CTGVL
66 . . K ^ORD(102.21,RPTID,1,IX,1,"B") S ^ORD(102.21,RPTID,1,IX,1,"B",CTGVL,1)="",JX=1
67SCHRPT ;
68 S (IX,JX,RPTID,CTGVL)=0
69 S RPTID=$O(^ORD(102.21,"B","RPT SCHEDULED/DUE ACTIVITY",0))
70 F S IX=$O(^ORD(102.21,RPTID,1,IX)) Q:('IX)!JX D
71 . I $P(^(IX,0),U,4)="IMAGING" D
72 . . S CTGVL=$O(^ORD(100.98,"B","IMAGING",0))
73 . . S ^ORD(102.21,RPTID,1,IX,1,1,0)=CTGVL
74 . . K ^ORD(102.21,RPTID,1,IX,1,"B") S ^ORD(102.21,RPTID,1,IX,1,"B",CTGVL,1)=""
75 Q
76QUE ; -- Task xref job
77 N ZTIO,ZTDTH,ZTDESC,ZTRTN,ZTSK,ZTSAVE
78 S ZTIO="",ZTDTH=$H,ZTDESC="Rebuild ARS xref on Orders file #100"
79 S ZTRTN="ARS^ORY153" D ^%ZTLOAD
80 S X="Task "_$S($G(ZTSK):"#"_ZTSK,1:"not")_" started to rebuild ^OR(100,""ARS"")." D BMES^XPDUTL(X)
81 Q
82ARS ; -- Add Patient subscript to xref for test sites
83 N ORFIRST,ORIDX,ORIFN,ORVP,ORDT
84 S ORIDX=$Q(^OR(100,"ARS")) Q:ORIDX'["ARS" Q:$L(ORIDX,",")>4
85 S ORFIRST=+$P(ORIDX,",",4) F S ORIDX=$Q(@ORIDX) Q:ORIDX'?1"^OR(100,""ARS"",".E S ORIFN=+$P(ORIDX,",",4) S:ORIFN<ORFIRST ORFIRST=ORIFN
86 K ^OR(100,"ARS") S ORIFN=ORFIRST-.1
87 F S ORIFN=$O(^OR(100,ORIFN)) Q:ORIFN<1 D
88 . S ORDT=+$G(^OR(100,ORIFN,7)) Q:ORDT<1 S ORVP=$P($G(^(0)),U,2)
89 . S ^OR(100,"ARS",ORVP,9999999-ORDT,ORIFN)=""
90 Q
91DATA ; parameter data
92 ;;12848,"KEY")
93 ;;ORHEPC ABNORMAL START^1
94 ;;12848,"VAL")
95 ;;FEB 14, 2003
Note: See TracBrowser for help on using the repository browser.