- 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 Jan 18, 2025@03:31:12 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