ORDV01 ; slc/dcm - OE/RR Report Extracts ;10/8/03 11:18
;;3.0;ORDER ENTRY/RESULTS REPORTING;**109,160,180,208,215,274**;Dec 17, 1997;Build 20
HSQUERY(ROOT,ORDFN,ID,ORALPHA,OROMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ; -- Query to Health Summary Reports
N OUT,ORDBEG,ORDEND,OREXT
Q:'$L($G(ID))
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
. D GCPR^OMGCOAS1(DFN,ORFHIE,ORALPHA,OROMEGA,$G(ORMAX,100))
. S ROOT=$NA(^TMP("ORDATA",$J))
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
Q:'$L($P(ID,";",2))
S OUT=$P(ID,";")_"^"_$P(ID,";",2),OREXT=$S($L($P(ID,";",8)):$P(ID,";",7,9),1:"")
Q:'$L($T(@OUT))
S:'$G(ORALPHA) ORALPHA=$$FMADD^XLFDT(DT,-2000) S:'$G(OROMEGA) OROMEGA=$$FMADD^XLFDT(DT,1)
I $E(OROMEGA,8)'="." S OROMEGA=OROMEGA_".235959"
S OROMEGA=9999999-OROMEGA,ORALPHA=9999999-ORALPHA
S ORDBEG=$S(ORALPHA=9999999:1,1:9999999-ORALPHA)
S ORDEND=$S(OROMEGA=6666666:9999999,$P(OROMEGA,".",2)="01":$P(9999999-OROMEGA,".")_".235959",1:9999999-OROMEGA)
S:'$G(ORMAX) ORMAX=100
S OUT=OUT_"(.ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT)"
D @OUT
Q
ADR(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;adverse/reaction allergies
;External calls to ^GMRADPT, file 120.8
;Date ranges and Max Occurances are not supported by ^GMTADPT, but Max Occ is enforced in following FOR loop
;
I $L($T(GCPR^OMGCOAS1)) D Q ; Call if FHIE station 200
. ;D GCPR^OMGCOAS1(DFN,"ALRG",ORDBEG,ORDEND,ORMAX) ;Next 2 lines for HDRHX CHANGE
. I $E($P(OREXT,";",3),1,8)="OR_HDRX_",$L($T(HX^OMGCOAS1)) D HX^OMGCOAS1(DFN,$P(OREXT,";",3),ORDBEG,ORDEND,ORMAX)
. I $E($P(OREXT,";",3),1,8)'="OR_HDRX_" D GCPR^OMGCOAS1(DFN,"ALRG",ORDBEG,ORDEND,ORMAX)
. S ROOT=$NA(^TMP("ORDATA",$J))
;
N I,ORI,D0,ARR,GMRA,GMRAL,ALLRG,ORSITE,SITE,GO,DIC,DIQ,DR,DA,C1,C2,LINE,LINE1,CDT,CTR,X
Q:'$L(OREXT)
S GO=$P(OREXT,";")_"^"_$P(OREXT,";",2)
Q:'$L($T(@GO))
S GMRA="0^0^111",ORSITE=$$SITE^VASITE,ORSITE=$P(ORSITE,"^",2)_";"_$P(ORSITE,"^",3)
K ^TMP("ORDATA",$J)
D @GO
I GMRAL=""!(GMRAL=0) S ^TMP("ORDATA",$J,1,"WP",1)="1^"_ORSITE,^(2)="2^"_$S(GMRAL="":"Not Assessed",1:"NKA")
S D0=0
F ORI=1:1 S D0=$O(GMRAL(D0)) Q:'D0 D
. S SITE=$S($L($G(GMRAL(D0,"facility"))):GMRAL(D0,"facility"),1:ORSITE)
. K ARR,LINE,LINE1
. S DIC=120.8,DA=D0,DR="3.1;.02;20;6",DIQ="ARR" D EN^DIQ1
. S DIQ=$E(DIQ,1,$L(DIQ)-1)
. S ^TMP("ORDATA",$J,ORI,"WP",1)="1^"_SITE ;Station ID
. S ^TMP("ORDATA",$J,ORI,"WP",2)="2^"_@DIQ@(120.8,DA,.02) ;Allergy Reactant
. S ^TMP("ORDATA",$J,ORI,"WP",3)="3^"_@DIQ@(120.8,DA,3.1) ;Allergy Type
. S ^TMP("ORDATA",$J,ORI,"WP",4)="4^"_$$DATEMMM^ORDVU(@DIQ@(120.8,DA,20)) ;Verification Date/Time
. S ^TMP("ORDATA",$J,ORI,"WP",5)="5^"_@DIQ@(120.8,DA,6) ;Observed/Historical
. S ^TMP("ORDATA",$J,ORI,"WP",7)="7^"_DA ;Allergy IEN
. S C1="",CTR=0
. F I=1:1:10 K ARAY,ERR S CDT=$$GET1^DIQ(120.826,I_","_DA_",",".01","I") I $L(CDT) D
.. S LINE(CDT)=$$GET1^DIQ(120.826,I_","_DA_",","1")_"^"_$$GET1^DIQ(120.826,I_","_DA_",","1.5")
.. S X=$$GET1^DIQ(120.826,I_","_DA_",","2","","ARAY","ERR") I $L(X),'$D(ERR) D
... S C1="" F S C1=$O(ARAY(C1)) Q:C1="" S LINE(CDT,"C",C1)=ARAY(C1)
. S C1="" F S C1=$O(LINE(C1)) Q:C1="" S X=LINE(C1) D
.. S CTR=CTR+1,LINE1("C",CTR)=" "_$TR($$FMTE^XLFDT(C1,"5ZM"),"@"," ")_" by "_$P(X,"^")_" ("_$P(X,"^",2)_")",C2=""
.. F S C2=$O(LINE(C1,"C",C2)) Q:C2="" S CTR=CTR+1,LINE1("C",CTR)=" "_LINE(C1,"C",C2)
. D SPMRG^ORDVU("LINE1(""C"")","^TMP(""ORDATA"","_$J_","_ORI_",""WP"",6)",6) ;Comment
S ROOT=$NA(^TMP("ORDATA",$J))
Q
ADRZ(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;adverse/reaction allergies (Old extract - not used)
;External calls to ^GMTADPT, file 120.8
;Date ranges and Max Occurances are not supported by ^GMTADPT, but Max Occ is enforced in following FOR loop
N ORI,D0,ARR,GMRA,GMRAL,ALLRG,ORSITE,SITE,GO
Q:'$L(OREXT)
S GO=$P(OREXT,";")_"^"_$P(OREXT,";",2)
Q:'$L($T(@GO))
S GMRA="0^0^111",ORSITE=$$SITE^VASITE,ORSITE=$P(ORSITE,"^",2)_";"_$P(ORSITE,"^",3)
K ^TMP("ORHSADR",$J)
D @GO
I GMRAL="" Q
S D0=0
F ORI=1:1 S D0=$O(GMRAL(D0)) Q:'D0 D
. S SITE=$S($L($G(GMRAL(D0,"facility"))):GMRAL(D0,"facility"),1:ORSITE)
. K ARR
. S DIC=120.8,DA=D0,DR="3.1;.02;20;6",DIQ="ARR" D EN^DIQ1
. S DIQ=$E(DIQ,1,$L(DIQ)-1)
. 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)
S ROOT=$NA(^TMP("ORHSADR",$J))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORDV01 4582 printed Oct 16, 2024@18:30:38 Page 2
ORDV01 ; slc/dcm - OE/RR Report Extracts ;10/8/03 11:18
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**109,160,180,208,215,274**;Dec 17, 1997;Build 20
HSQUERY(ROOT,ORDFN,ID,ORALPHA,OROMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ; -- Query to Health Summary Reports
+1 NEW OUT,ORDBEG,ORDEND,OREXT
+2 if '$LENGTH($GET(ID))
QUIT
+3 ;Call if FHIE station 200
IF '$LENGTH($PIECE(ID,";",2))
IF $PIECE(ID,";",3)
IF $LENGTH($TEXT(HSTYPE^ORWRP1))&($LENGTH($TEXT(GCPR^OMGCOAS1)))
IF $LENGTH($GET(ORFHIE))
Begin DoDot:1
+4 DO GCPR^OMGCOAS1(DFN,ORFHIE,ORALPHA,OROMEGA,$GET(ORMAX,100))
+5 SET ROOT=$NAME(^TMP("ORDATA",$JOB))
End DoDot:1
QUIT
+6 IF '$LENGTH($PIECE(ID,";",2))
IF $PIECE(ID,";",3)
IF $LENGTH($TEXT(HSTYPE^ORWRP1))
DO HSTYPE^ORWRP1(ROOT,ORDFN,$PIECE(ID,";",3),.ORALPHA,.OROMEGA,.ORDTRNG,.REMOTE)
QUIT
+7 if '$LENGTH($PIECE(ID,";",2))
QUIT
+8 SET OUT=$PIECE(ID,";")_"^"_$PIECE(ID,";",2)
SET OREXT=$SELECT($LENGTH($PIECE(ID,";",8)):$PIECE(ID,";",7,9),1:"")
+9 if '$LENGTH($TEXT(@OUT))
QUIT
+10 if '$GET(ORALPHA)
SET ORALPHA=$$FMADD^XLFDT(DT,-2000)
if '$GET(OROMEGA)
SET OROMEGA=$$FMADD^XLFDT(DT,1)
+11 IF $EXTRACT(OROMEGA,8)'="."
SET OROMEGA=OROMEGA_".235959"
+12 SET OROMEGA=9999999-OROMEGA
SET ORALPHA=9999999-ORALPHA
+13 SET ORDBEG=$SELECT(ORALPHA=9999999:1,1:9999999-ORALPHA)
+14 SET ORDEND=$SELECT(OROMEGA=6666666:9999999,$PIECE(OROMEGA,".",2)="01":$PIECE(9999999-OROMEGA,".")_".235959",1:9999999-OROMEGA)
+15 if '$GET(ORMAX)
SET ORMAX=100
+16 SET OUT=OUT_"(.ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT)"
+17 DO @OUT
+18 QUIT
ADR(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;adverse/reaction allergies
+1 ;External calls to ^GMRADPT, file 120.8
+2 ;Date ranges and Max Occurances are not supported by ^GMTADPT, but Max Occ is enforced in following FOR loop
+3 ;
+4 ; Call if FHIE station 200
IF $LENGTH($TEXT(GCPR^OMGCOAS1))
Begin DoDot:1
+5 ;D GCPR^OMGCOAS1(DFN,"ALRG",ORDBEG,ORDEND,ORMAX) ;Next 2 lines for HDRHX CHANGE
+6 IF $EXTRACT($PIECE(OREXT,";",3),1,8)="OR_HDRX_"
IF $LENGTH($TEXT(HX^OMGCOAS1))
DO HX^OMGCOAS1(DFN,$PIECE(OREXT,";",3),ORDBEG,ORDEND,ORMAX)
+7 IF $EXTRACT($PIECE(OREXT,";",3),1,8)'="OR_HDRX_"
DO GCPR^OMGCOAS1(DFN,"ALRG",ORDBEG,ORDEND,ORMAX)
+8 SET ROOT=$NAME(^TMP("ORDATA",$JOB))
End DoDot:1
QUIT
+9 ;
+10 NEW I,ORI,D0,ARR,GMRA,GMRAL,ALLRG,ORSITE,SITE,GO,DIC,DIQ,DR,DA,C1,C2,LINE,LINE1,CDT,CTR,X
+11 if '$LENGTH(OREXT)
QUIT
+12 SET GO=$PIECE(OREXT,";")_"^"_$PIECE(OREXT,";",2)
+13 if '$LENGTH($TEXT(@GO))
QUIT
+14 SET GMRA="0^0^111"
SET ORSITE=$$SITE^VASITE
SET ORSITE=$PIECE(ORSITE,"^",2)_";"_$PIECE(ORSITE,"^",3)
+15 KILL ^TMP("ORDATA",$JOB)
+16 DO @GO
+17 IF GMRAL=""!(GMRAL=0)
SET ^TMP("ORDATA",$JOB,1,"WP",1)="1^"_ORSITE
SET ^(2)="2^"_$SELECT(GMRAL="":"Not Assessed",1:"NKA")
+18 SET D0=0
+19 FOR ORI=1:1
SET D0=$ORDER(GMRAL(D0))
if 'D0
QUIT
Begin DoDot:1
+20 SET SITE=$SELECT($LENGTH($GET(GMRAL(D0,"facility"))):GMRAL(D0,"facility"),1:ORSITE)
+21 KILL ARR,LINE,LINE1
+22 SET DIC=120.8
SET DA=D0
SET DR="3.1;.02;20;6"
SET DIQ="ARR"
DO EN^DIQ1
+23 SET DIQ=$EXTRACT(DIQ,1,$LENGTH(DIQ)-1)
+24 ;Station ID
SET ^TMP("ORDATA",$JOB,ORI,"WP",1)="1^"_SITE
+25 ;Allergy Reactant
SET ^TMP("ORDATA",$JOB,ORI,"WP",2)="2^"_@DIQ@(120.8,DA,.02)
+26 ;Allergy Type
SET ^TMP("ORDATA",$JOB,ORI,"WP",3)="3^"_@DIQ@(120.8,DA,3.1)
+27 ;Verification Date/Time
SET ^TMP("ORDATA",$JOB,ORI,"WP",4)="4^"_$$DATEMMM^ORDVU(@DIQ@(120.8,DA,20))
+28 ;Observed/Historical
SET ^TMP("ORDATA",$JOB,ORI,"WP",5)="5^"_@DIQ@(120.8,DA,6)
+29 ;Allergy IEN
SET ^TMP("ORDATA",$JOB,ORI,"WP",7)="7^"_DA
+30 SET C1=""
SET CTR=0
+31 FOR I=1:1:10
KILL ARAY,ERR
SET CDT=$$GET1^DIQ(120.826,I_","_DA_",",".01","I")
IF $LENGTH(CDT)
Begin DoDot:2
+32 SET LINE(CDT)=$$GET1^DIQ(120.826,I_","_DA_",","1")_"^"_$$GET1^DIQ(120.826,I_","_DA_",","1.5")
+33 SET X=$$GET1^DIQ(120.826,I_","_DA_",","2","","ARAY","ERR")
IF $LENGTH(X)
IF '$DATA(ERR)
Begin DoDot:3
+34 SET C1=""
FOR
SET C1=$ORDER(ARAY(C1))
if C1=""
QUIT
SET LINE(CDT,"C",C1)=ARAY(C1)
End DoDot:3
End DoDot:2
+35 SET C1=""
FOR
SET C1=$ORDER(LINE(C1))
if C1=""
QUIT
SET X=LINE(C1)
Begin DoDot:2
+36 SET CTR=CTR+1
SET LINE1("C",CTR)=" "_$TRANSLATE($$FMTE^XLFDT(C1,"5ZM"),"@"," ")_" by "_$PIECE(X,"^")_" ("_$PIECE(X,"^",2)_")"
SET C2=""
+37 FOR
SET C2=$ORDER(LINE(C1,"C",C2))
if C2=""
QUIT
SET CTR=CTR+1
SET LINE1("C",CTR)=" "_LINE(C1,"C",C2)
End DoDot:2
+38 ;Comment
DO SPMRG^ORDVU("LINE1(""C"")","^TMP(""ORDATA"","_$JOB_","_ORI_",""WP"",6)",6)
End DoDot:1
+39 SET ROOT=$NAME(^TMP("ORDATA",$JOB))
+40 QUIT
ADRZ(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;adverse/reaction allergies (Old extract - not used)
+1 ;External calls to ^GMTADPT, file 120.8
+2 ;Date ranges and Max Occurances are not supported by ^GMTADPT, but Max Occ is enforced in following FOR loop
+3 NEW ORI,D0,ARR,GMRA,GMRAL,ALLRG,ORSITE,SITE,GO
+4 if '$LENGTH(OREXT)
QUIT
+5 SET GO=$PIECE(OREXT,";")_"^"_$PIECE(OREXT,";",2)
+6 if '$LENGTH($TEXT(@GO))
QUIT
+7 SET GMRA="0^0^111"
SET ORSITE=$$SITE^VASITE
SET ORSITE=$PIECE(ORSITE,"^",2)_";"_$PIECE(ORSITE,"^",3)
+8 KILL ^TMP("ORHSADR",$JOB)
+9 DO @GO
+10 IF GMRAL=""
QUIT
+11 SET D0=0
+12 FOR ORI=1:1
SET D0=$ORDER(GMRAL(D0))
if 'D0
QUIT
Begin DoDot:1
+13 SET SITE=$SELECT($LENGTH($GET(GMRAL(D0,"facility"))):GMRAL(D0,"facility"),1:ORSITE)
+14 KILL ARR
+15 SET DIC=120.8
SET DA=D0
SET DR="3.1;.02;20;6"
SET DIQ="ARR"
DO EN^DIQ1
+16 SET DIQ=$EXTRACT(DIQ,1,$LENGTH(DIQ)-1)
+17 SET ^TMP("ORHSADR",$JOB,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)
End DoDot:1
+18 SET ROOT=$NAME(^TMP("ORHSADR",$JOB))
+19 QUIT
