source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORDV01.m@ 810

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

initial load of WorldVistAEHR
File size: 4.4 KB
RevLine 
[613]1ORDV01 ; slc/dcm - OE/RR Report Extracts ;10/8/03 11:18
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**109,160,180,208,215,274**;Dec 17, 1997;Build 20
3HSQUERY(ROOT,ORDFN,ID,ORALPHA,OROMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ; -- Query to Health Summary Reports
4 N OUT,ORDBEG,ORDEND,OREXT
5 Q:'$L($G(ID))
6 I '$L($P(ID,";",2)),$P(ID,";",3),$L($T(HSTYPE^ORWRP1))&($L($T(GCPR^OMGCOAS1))),$L($G(ORFHIE)) D Q ;Call if FHIE station 200
7 . D GCPR^OMGCOAS1(DFN,ORFHIE,ORALPHA,OROMEGA,$G(ORMAX,100))
8 . S ROOT=$NA(^TMP("ORDATA",$J))
9 I '$L($P(ID,";",2)),$P(ID,";",3),$L($T(HSTYPE^ORWRP1)) D HSTYPE^ORWRP1(ROOT,ORDFN,$P(ID,";",3),.ORALPHA,.OROMEGA,.ORDTRNG,.REMOTE) Q
10 Q:'$L($P(ID,";",2))
11 S OUT=$P(ID,";")_"^"_$P(ID,";",2),OREXT=$S($L($P(ID,";",8)):$P(ID,";",7,9),1:"")
12 Q:'$L($T(@OUT))
13 S:'$G(ORALPHA) ORALPHA=$$FMADD^XLFDT(DT,-2000) S:'$G(OROMEGA) OROMEGA=$$FMADD^XLFDT(DT,1)
14 I $E(OROMEGA,8)'="." S OROMEGA=OROMEGA_".235959"
15 S OROMEGA=9999999-OROMEGA,ORALPHA=9999999-ORALPHA
16 S ORDBEG=$S(ORALPHA=9999999:1,1:9999999-ORALPHA)
17 S ORDEND=$S(OROMEGA=6666666:9999999,$P(OROMEGA,".",2)="01":$P(9999999-OROMEGA,".")_".235959",1:9999999-OROMEGA)
18 S:'$G(ORMAX) ORMAX=100
19 S OUT=OUT_"(.ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT)"
20 D @OUT
21 Q
22ADR(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;adverse/reaction allergies
23 ;External calls to ^GMRADPT, file 120.8
24 ;Date ranges and Max Occurances are not supported by ^GMTADPT, but Max Occ is enforced in following FOR loop
25 ;
26 I $L($T(GCPR^OMGCOAS1)) D Q ; Call if FHIE station 200
27 . ;D GCPR^OMGCOAS1(DFN,"ALRG",ORDBEG,ORDEND,ORMAX) ;Next 2 lines for HDRHX CHANGE
28 . I $E($P(OREXT,";",3),1,8)="OR_HDRX_",$L($T(HX^OMGCOAS1)) D HX^OMGCOAS1(DFN,$P(OREXT,";",3),ORDBEG,ORDEND,ORMAX)
29 . I $E($P(OREXT,";",3),1,8)'="OR_HDRX_" D GCPR^OMGCOAS1(DFN,"ALRG",ORDBEG,ORDEND,ORMAX)
30 . S ROOT=$NA(^TMP("ORDATA",$J))
31 ;
32 N I,ORI,D0,ARR,GMRA,GMRAL,ALLRG,ORSITE,SITE,GO,DIC,DIQ,DR,DA,C1,C2,LINE,LINE1,CDT,CTR,X
33 Q:'$L(OREXT)
34 S GO=$P(OREXT,";")_"^"_$P(OREXT,";",2)
35 Q:'$L($T(@GO))
36 S GMRA="0^0^111",ORSITE=$$SITE^VASITE,ORSITE=$P(ORSITE,"^",2)_";"_$P(ORSITE,"^",3)
37 K ^TMP("ORDATA",$J)
38 D @GO
39 I GMRAL=""!(GMRAL=0) S ^TMP("ORDATA",$J,1,"WP",1)="1^"_ORSITE,^(2)="2^"_$S(GMRAL="":"Not Assessed",1:"NKA")
40 S D0=0
41 F ORI=1:1 S D0=$O(GMRAL(D0)) Q:'D0 D
42 . S SITE=$S($L($G(GMRAL(D0,"facility"))):GMRAL(D0,"facility"),1:ORSITE)
43 . K ARR,LINE,LINE1
44 . S DIC=120.8,DA=D0,DR="3.1;.02;20;6",DIQ="ARR" D EN^DIQ1
45 . S DIQ=$E(DIQ,1,$L(DIQ)-1)
46 . S ^TMP("ORDATA",$J,ORI,"WP",1)="1^"_SITE ;Station ID
47 . S ^TMP("ORDATA",$J,ORI,"WP",2)="2^"_@DIQ@(120.8,DA,.02) ;Allergy Reactant
48 . S ^TMP("ORDATA",$J,ORI,"WP",3)="3^"_@DIQ@(120.8,DA,3.1) ;Allergy Type
49 . S ^TMP("ORDATA",$J,ORI,"WP",4)="4^"_$$DATEMMM^ORDVU(@DIQ@(120.8,DA,20)) ;Verification Date/Time
50 . S ^TMP("ORDATA",$J,ORI,"WP",5)="5^"_@DIQ@(120.8,DA,6) ;Observed/Historical
51 . S ^TMP("ORDATA",$J,ORI,"WP",7)="7^"_DA ;Allergy IEN
52 . S C1="",CTR=0
53 . F I=1:1:10 K ARAY,ERR S CDT=$$GET1^DIQ(120.826,I_","_DA_",",".01","I") I $L(CDT) D
54 .. S LINE(CDT)=$$GET1^DIQ(120.826,I_","_DA_",","1")_"^"_$$GET1^DIQ(120.826,I_","_DA_",","1.5")
55 .. S X=$$GET1^DIQ(120.826,I_","_DA_",","2","","ARAY","ERR") I $L(X),'$D(ERR) D
56 ... S C1="" F S C1=$O(ARAY(C1)) Q:C1="" S LINE(CDT,"C",C1)=ARAY(C1)
57 . S C1="" F S C1=$O(LINE(C1)) Q:C1="" S X=LINE(C1) D
58 .. S CTR=CTR+1,LINE1("C",CTR)=" "_$TR($$FMTE^XLFDT(C1,"5ZM"),"@"," ")_" by "_$P(X,"^")_" ("_$P(X,"^",2)_")",C2=""
59 .. F S C2=$O(LINE(C1,"C",C2)) Q:C2="" S CTR=CTR+1,LINE1("C",CTR)=" "_LINE(C1,"C",C2)
60 . D SPMRG^ORDVU("LINE1(""C"")","^TMP(""ORDATA"","_$J_","_ORI_",""WP"",6)",6) ;Comment
61 S ROOT=$NA(^TMP("ORDATA",$J))
62 Q
63ADRZ(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;adverse/reaction allergies (Old extract - not used)
64 ;External calls to ^GMTADPT, file 120.8
65 ;Date ranges and Max Occurances are not supported by ^GMTADPT, but Max Occ is enforced in following FOR loop
66 N ORI,D0,ARR,GMRA,GMRAL,ALLRG,ORSITE,SITE,GO
67 Q:'$L(OREXT)
68 S GO=$P(OREXT,";")_"^"_$P(OREXT,";",2)
69 Q:'$L($T(@GO))
70 S GMRA="0^0^111",ORSITE=$$SITE^VASITE,ORSITE=$P(ORSITE,"^",2)_";"_$P(ORSITE,"^",3)
71 K ^TMP("ORHSADR",$J)
72 D @GO
73 I GMRAL="" Q
74 S D0=0
75 F ORI=1:1 S D0=$O(GMRAL(D0)) Q:'D0 D
76 . S SITE=$S($L($G(GMRAL(D0,"facility"))):GMRAL(D0,"facility"),1:ORSITE)
77 . K ARR
78 . S DIC=120.8,DA=D0,DR="3.1;.02;20;6",DIQ="ARR" D EN^DIQ1
79 . S DIQ=$E(DIQ,1,$L(DIQ)-1)
80 . S ^TMP("ORHSADR",$J,ORI)=SITE_U_U_@DIQ@(120.8,DA,3.1)_U_@DIQ@(120.8,DA,.02)_U_$$DATEMMM^ORDVU(@DIQ@(120.8,DA,20))_U_@DIQ@(120.8,DA,6)
81 S ROOT=$NA(^TMP("ORHSADR",$J))
82 Q
Note: See TracBrowser for help on using the repository browser.