ORWGAPI1 ; SLC/STAFF - Graph Items ;12/21/05 08:15
;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,243**;Dec 17, 1997;Build 242
;
AA(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
; FMT,OLDEST,NEWEST not used
N ITEM,FILE,NUM,REF,RESULT
K ^TMP("ORWGRPC DC",$J)
S ITEM=""
F S ITEM=$O(^PXRMINDX(63,"PI",DFN,ITEM)) Q:ITEM="" D
. I $E(ITEM)="A" Q
. I $E(ITEM)="M" Q
. S RESULT=$$AALAB^ORWGAPIC(ITEM)
. I RESULT="" Q
. S RESULT="68^"_RESULT
. S ^TMP("ORWGRPC DC",$J,RESULT)=""
S RESULT=""
F S RESULT=$O(^TMP("ORWGRPC DC",$J,RESULT)) Q:RESULT="" S CNT=CNT+1 D
. D SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
K ^TMP("ORWGRPC DC",$J)
Q
;
AP(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
N DATE,ITEM,OK,RESULT
S ITEM="A"
F S ITEM=$O(^PXRMINDX(63,"PI",DFN,ITEM)) Q:ITEM="" Q:ITEM]"AZ" D
. S OK=0
. I FMT=6 D
.. S DATE=OLDEST
.. F S DATE=$O(^PXRMINDX(63,"PI",DFN,ITEM,DATE)) Q:DATE="" Q:DATE>NEWEST D Q:OK
... S CNT=CNT+1
... S OK=1
... S RESULT="63AP"_U_ITEM
. I FMT=3 D
.. S DATE=$O(^PXRMINDX(63,"PI",DFN,ITEM,""),-1)
.. I 'DATE Q
.. S OK=1
.. S CNT=CNT+1
.. S RESULT="63AP^"_ITEM_"^^"_$$ITEMPRFX^ORWGAPIU(ITEM)_": "_$$EVALUE^ORWGAPIU(ITEM,63,.01)_"^^"_DATE
. I FMT=0 D
.. S OK=1
.. S CNT=CNT+1
.. S RESULT="63AP^"_ITEM_U_$$ITEMPRFX^ORWGAPIU(ITEM)_": "_$$EVALUE^ORWGAPIU(ITEM,63,.01)
. I OK D SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
Q
;
LAB(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
N DATE,ITEM,OK,RESULT
S ITEM=0
F S ITEM=$O(^PXRMINDX(63,"PI",DFN,ITEM)) Q:ITEM<1 D
. S OK=0
. I FMT=6 D
.. S DATE=OLDEST
.. F S DATE=$O(^PXRMINDX(63,"PI",DFN,ITEM,DATE)) Q:DATE="" Q:DATE>NEWEST D Q:OK
... S CNT=CNT+1
... S OK=1
... S RESULT=63_U_ITEM
. I FMT=3 D
.. S DATE=$O(^PXRMINDX(63,"PI",DFN,ITEM,""),-1)
.. I 'DATE Q
.. S CNT=CNT+1
.. S OK=1
.. S RESULT=63_U_ITEM_"^^"_$$EVALUE^ORWGAPIU(ITEM,63,.01)_"^^"_DATE
. I FMT=0 D
.. S CNT=CNT+1
.. S OK=1
.. S RESULT=63_U_ITEM_U_$$EVALUE^ORWGAPIU(ITEM,63,.01)
. I OK D
.. S RESULT=RESULT_U_$$AALAB^ORWGAPIC(ITEM)
.. D SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
Q
;
MI(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
N DATE,ITEM,OK,RESULT
S ITEM="M"
F S ITEM=$O(^PXRMINDX(63,"PI",DFN,ITEM)) Q:ITEM="" Q:ITEM]"MZ" D
. S OK=0
. I FMT=6 D
.. S DATE=OLDEST
.. F S DATE=$O(^PXRMINDX(63,"PI",DFN,ITEM,DATE)) Q:DATE="" Q:DATE>NEWEST D Q:OK
... S CNT=CNT+1
... S OK=1
... S RESULT="63MI"_U_ITEM
. I FMT=3 D
.. S DATE=$O(^PXRMINDX(63,"PI",DFN,ITEM,""),-1)
.. I 'DATE Q
.. S CNT=CNT+1
.. S OK=1
.. S RESULT="63MI^"_ITEM_"^^"_$$ITEMPRFX^ORWGAPIU(ITEM)_": "_$$EVALUE^ORWGAPIU(ITEM,63,.01)_"^^"_DATE
. I FMT=0 D
.. S CNT=CNT+1
.. S OK=1
.. S RESULT="63MI^"_ITEM_U_$$ITEMPRFX^ORWGAPIU(ITEM)_": "_$$EVALUE^ORWGAPIU(ITEM,63,.01)
. I OK D SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
Q
;
MED(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
D MED1^ORWGAPIE(.ITEMS,DFN,FMT,OLDEST,NEWEST,.CNT,.TMP)
Q
;
NOTES(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
N DATE,DOC,DOCCLASS,DOCIEN,DOCTYPE,DUMMY,RESULT,RESULTS,TITLE K DUMMY
K ^TMP("ORWGRPC TEMP",$J),^TMP("TIUR",$J)
S CNT=$G(CNT)
I FMT=6 D
. F DOCTYPE="P","D","C" D
.. S DOCCLASS=$$DOCCLASS^ORWGAPIA(DOCTYPE)
.. K ^TMP("TIUR",$J)
.. D TIU^ORWGAPIA(.DUMMY,DOCCLASS,5,DFN,$G(OLDEST),$G(NEWEST))
.. S DOC=0
.. F S DOC=$O(^TMP("TIUR",$J,DOC)) Q:DOC<1 D
... S RESULTS=^TMP("TIUR",$J,DOC)
... S TITLE=$P(RESULTS,U,2)
... S DATE=$P(RESULTS,U,3)
... I '$L(TITLE) Q
... S ^TMP("ORWGRPC TEMP",$J,TITLE,DATE)=RESULTS
I FMT'=6 D
. F DOCTYPE="P","D","C" D
.. S DOCCLASS=$$DOCCLASS^ORWGAPIA(DOCTYPE)
.. K ^TMP("TIUR",$J)
.. D TIU^ORWGAPIA(.DUMMY,DOCCLASS,5,DFN)
.. S DOC=0
.. F S DOC=$O(^TMP("TIUR",$J,DOC)) Q:DOC<1 D
... S RESULTS=^TMP("TIUR",$J,DOC)
... S TITLE=$P(RESULTS,U,2)
... S DATE=$P(RESULTS,U,3)
... I '$L(TITLE) Q
... S ^TMP("ORWGRPC TEMP",$J,TITLE,DATE)=RESULTS
S TITLE=""
F S TITLE=$O(^TMP("ORWGRPC TEMP",$J,TITLE)) Q:TITLE="" D
. S CNT=CNT+1
. I FMT=6 S RESULT=8925_U_TITLE
. I FMT=3 D
.. S DATE=+$O(^TMP("ORWGRPC TEMP",$J,TITLE,""),-1)
.. S DOCIEN=+$G(^TMP("ORWGRPC TEMP",$J,TITLE,DATE))
.. S RESULT=8925_U_TITLE_"^^"_TITLE_"^^"
.. S RESULT=RESULT_DATE
.. S RESULT=RESULT_U_$$TITLE^ORWGAPIA(DOCIEN)
. I FMT=0 S RESULT=8925_U_TITLE_U_TITLE
. S RESULT=$$UP^ORWGAPIX(RESULT)
. D SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
K ^TMP("ORWGRPC TEMP",$J),^TMP("TIUR",$J)
Q
;
TITLE(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
; FMT,OLDEST,NEWEST not used
N ITEM,FILE,NUM,REF,RESULT
K ^TMP("ORWGRPC DC",$J)
S ITEM=""
F S ITEM=$O(^PXRMINDX(63,"PI",DFN,ITEM)) Q:ITEM="" D
. I $E(ITEM)="A" Q
. I $E(ITEM)="M" Q
. S RESULT=$$AALAB^ORWGAPIC(ITEM)
. I RESULT="" Q
. S RESULT="68^"_RESULT
. S ^TMP("ORWGRPC DC",$J,RESULT)=""
S RESULT=""
F S RESULT=$O(^TMP("ORWGRPC DC",$J,RESULT)) Q:RESULT="" S CNT=CNT+1 D
. D SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
K ^TMP("ORWGRPC DC",$J)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWGAPI1 5087 printed Dec 13, 2024@02:36:11 Page 2
ORWGAPI1 ; SLC/STAFF - Graph Items ;12/21/05 08:15
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,243**;Dec 17, 1997;Build 242
+2 ;
AA(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
+1 ; FMT,OLDEST,NEWEST not used
+2 NEW ITEM,FILE,NUM,REF,RESULT
+3 KILL ^TMP("ORWGRPC DC",$JOB)
+4 SET ITEM=""
+5 FOR
SET ITEM=$ORDER(^PXRMINDX(63,"PI",DFN,ITEM))
if ITEM=""
QUIT
Begin DoDot:1
+6 IF $EXTRACT(ITEM)="A"
QUIT
+7 IF $EXTRACT(ITEM)="M"
QUIT
+8 SET RESULT=$$AALAB^ORWGAPIC(ITEM)
+9 IF RESULT=""
QUIT
+10 SET RESULT="68^"_RESULT
+11 SET ^TMP("ORWGRPC DC",$JOB,RESULT)=""
End DoDot:1
+12 SET RESULT=""
+13 FOR
SET RESULT=$ORDER(^TMP("ORWGRPC DC",$JOB,RESULT))
if RESULT=""
QUIT
SET CNT=CNT+1
Begin DoDot:1
+14 DO SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
End DoDot:1
+15 KILL ^TMP("ORWGRPC DC",$JOB)
+16 QUIT
+17 ;
AP(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
+1 NEW DATE,ITEM,OK,RESULT
+2 SET ITEM="A"
+3 FOR
SET ITEM=$ORDER(^PXRMINDX(63,"PI",DFN,ITEM))
if ITEM=""
QUIT
if ITEM]"AZ"
QUIT
Begin DoDot:1
+4 SET OK=0
+5 IF FMT=6
Begin DoDot:2
+6 SET DATE=OLDEST
+7 FOR
SET DATE=$ORDER(^PXRMINDX(63,"PI",DFN,ITEM,DATE))
if DATE=""
QUIT
if DATE>NEWEST
QUIT
Begin DoDot:3
+8 SET CNT=CNT+1
+9 SET OK=1
+10 SET RESULT="63AP"_U_ITEM
End DoDot:3
if OK
QUIT
End DoDot:2
+11 IF FMT=3
Begin DoDot:2
+12 SET DATE=$ORDER(^PXRMINDX(63,"PI",DFN,ITEM,""),-1)
+13 IF 'DATE
QUIT
+14 SET OK=1
+15 SET CNT=CNT+1
+16 SET RESULT="63AP^"_ITEM_"^^"_$$ITEMPRFX^ORWGAPIU(ITEM)_": "_$$EVALUE^ORWGAPIU(ITEM,63,.01)_"^^"_DATE
End DoDot:2
+17 IF FMT=0
Begin DoDot:2
+18 SET OK=1
+19 SET CNT=CNT+1
+20 SET RESULT="63AP^"_ITEM_U_$$ITEMPRFX^ORWGAPIU(ITEM)_": "_$$EVALUE^ORWGAPIU(ITEM,63,.01)
End DoDot:2
+21 IF OK
DO SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
End DoDot:1
+22 QUIT
+23 ;
LAB(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
+1 NEW DATE,ITEM,OK,RESULT
+2 SET ITEM=0
+3 FOR
SET ITEM=$ORDER(^PXRMINDX(63,"PI",DFN,ITEM))
if ITEM<1
QUIT
Begin DoDot:1
+4 SET OK=0
+5 IF FMT=6
Begin DoDot:2
+6 SET DATE=OLDEST
+7 FOR
SET DATE=$ORDER(^PXRMINDX(63,"PI",DFN,ITEM,DATE))
if DATE=""
QUIT
if DATE>NEWEST
QUIT
Begin DoDot:3
+8 SET CNT=CNT+1
+9 SET OK=1
+10 SET RESULT=63_U_ITEM
End DoDot:3
if OK
QUIT
End DoDot:2
+11 IF FMT=3
Begin DoDot:2
+12 SET DATE=$ORDER(^PXRMINDX(63,"PI",DFN,ITEM,""),-1)
+13 IF 'DATE
QUIT
+14 SET CNT=CNT+1
+15 SET OK=1
+16 SET RESULT=63_U_ITEM_"^^"_$$EVALUE^ORWGAPIU(ITEM,63,.01)_"^^"_DATE
End DoDot:2
+17 IF FMT=0
Begin DoDot:2
+18 SET CNT=CNT+1
+19 SET OK=1
+20 SET RESULT=63_U_ITEM_U_$$EVALUE^ORWGAPIU(ITEM,63,.01)
End DoDot:2
+21 IF OK
Begin DoDot:2
+22 SET RESULT=RESULT_U_$$AALAB^ORWGAPIC(ITEM)
+23 DO SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
End DoDot:2
End DoDot:1
+24 QUIT
+25 ;
MI(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
+1 NEW DATE,ITEM,OK,RESULT
+2 SET ITEM="M"
+3 FOR
SET ITEM=$ORDER(^PXRMINDX(63,"PI",DFN,ITEM))
if ITEM=""
QUIT
if ITEM]"MZ"
QUIT
Begin DoDot:1
+4 SET OK=0
+5 IF FMT=6
Begin DoDot:2
+6 SET DATE=OLDEST
+7 FOR
SET DATE=$ORDER(^PXRMINDX(63,"PI",DFN,ITEM,DATE))
if DATE=""
QUIT
if DATE>NEWEST
QUIT
Begin DoDot:3
+8 SET CNT=CNT+1
+9 SET OK=1
+10 SET RESULT="63MI"_U_ITEM
End DoDot:3
if OK
QUIT
End DoDot:2
+11 IF FMT=3
Begin DoDot:2
+12 SET DATE=$ORDER(^PXRMINDX(63,"PI",DFN,ITEM,""),-1)
+13 IF 'DATE
QUIT
+14 SET CNT=CNT+1
+15 SET OK=1
+16 SET RESULT="63MI^"_ITEM_"^^"_$$ITEMPRFX^ORWGAPIU(ITEM)_": "_$$EVALUE^ORWGAPIU(ITEM,63,.01)_"^^"_DATE
End DoDot:2
+17 IF FMT=0
Begin DoDot:2
+18 SET CNT=CNT+1
+19 SET OK=1
+20 SET RESULT="63MI^"_ITEM_U_$$ITEMPRFX^ORWGAPIU(ITEM)_": "_$$EVALUE^ORWGAPIU(ITEM,63,.01)
End DoDot:2
+21 IF OK
DO SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
End DoDot:1
+22 QUIT
+23 ;
MED(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
+1 DO MED1^ORWGAPIE(.ITEMS,DFN,FMT,OLDEST,NEWEST,.CNT,.TMP)
+2 QUIT
+3 ;
NOTES(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
+1 NEW DATE,DOC,DOCCLASS,DOCIEN,DOCTYPE,DUMMY,RESULT,RESULTS,TITLE
KILL DUMMY
+2 KILL ^TMP("ORWGRPC TEMP",$JOB),^TMP("TIUR",$JOB)
+3 SET CNT=$GET(CNT)
+4 IF FMT=6
Begin DoDot:1
+5 FOR DOCTYPE="P","D","C"
Begin DoDot:2
+6 SET DOCCLASS=$$DOCCLASS^ORWGAPIA(DOCTYPE)
+7 KILL ^TMP("TIUR",$JOB)
+8 DO TIU^ORWGAPIA(.DUMMY,DOCCLASS,5,DFN,$GET(OLDEST),$GET(NEWEST))
+9 SET DOC=0
+10 FOR
SET DOC=$ORDER(^TMP("TIUR",$JOB,DOC))
if DOC<1
QUIT
Begin DoDot:3
+11 SET RESULTS=^TMP("TIUR",$JOB,DOC)
+12 SET TITLE=$PIECE(RESULTS,U,2)
+13 SET DATE=$PIECE(RESULTS,U,3)
+14 IF '$LENGTH(TITLE)
QUIT
+15 SET ^TMP("ORWGRPC TEMP",$JOB,TITLE,DATE)=RESULTS
End DoDot:3
End DoDot:2
End DoDot:1
+16 IF FMT'=6
Begin DoDot:1
+17 FOR DOCTYPE="P","D","C"
Begin DoDot:2
+18 SET DOCCLASS=$$DOCCLASS^ORWGAPIA(DOCTYPE)
+19 KILL ^TMP("TIUR",$JOB)
+20 DO TIU^ORWGAPIA(.DUMMY,DOCCLASS,5,DFN)
+21 SET DOC=0
+22 FOR
SET DOC=$ORDER(^TMP("TIUR",$JOB,DOC))
if DOC<1
QUIT
Begin DoDot:3
+23 SET RESULTS=^TMP("TIUR",$JOB,DOC)
+24 SET TITLE=$PIECE(RESULTS,U,2)
+25 SET DATE=$PIECE(RESULTS,U,3)
+26 IF '$LENGTH(TITLE)
QUIT
+27 SET ^TMP("ORWGRPC TEMP",$JOB,TITLE,DATE)=RESULTS
End DoDot:3
End DoDot:2
End DoDot:1
+28 SET TITLE=""
+29 FOR
SET TITLE=$ORDER(^TMP("ORWGRPC TEMP",$JOB,TITLE))
if TITLE=""
QUIT
Begin DoDot:1
+30 SET CNT=CNT+1
+31 IF FMT=6
SET RESULT=8925_U_TITLE
+32 IF FMT=3
Begin DoDot:2
+33 SET DATE=+$ORDER(^TMP("ORWGRPC TEMP",$JOB,TITLE,""),-1)
+34 SET DOCIEN=+$GET(^TMP("ORWGRPC TEMP",$JOB,TITLE,DATE))
+35 SET RESULT=8925_U_TITLE_"^^"_TITLE_"^^"
+36 SET RESULT=RESULT_DATE
+37 SET RESULT=RESULT_U_$$TITLE^ORWGAPIA(DOCIEN)
End DoDot:2
+38 IF FMT=0
SET RESULT=8925_U_TITLE_U_TITLE
+39 SET RESULT=$$UP^ORWGAPIX(RESULT)
+40 DO SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
End DoDot:1
+41 KILL ^TMP("ORWGRPC TEMP",$JOB),^TMP("TIUR",$JOB)
+42 QUIT
+43 ;
TITLE(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
+1 ; FMT,OLDEST,NEWEST not used
+2 NEW ITEM,FILE,NUM,REF,RESULT
+3 KILL ^TMP("ORWGRPC DC",$JOB)
+4 SET ITEM=""
+5 FOR
SET ITEM=$ORDER(^PXRMINDX(63,"PI",DFN,ITEM))
if ITEM=""
QUIT
Begin DoDot:1
+6 IF $EXTRACT(ITEM)="A"
QUIT
+7 IF $EXTRACT(ITEM)="M"
QUIT
+8 SET RESULT=$$AALAB^ORWGAPIC(ITEM)
+9 IF RESULT=""
QUIT
+10 SET RESULT="68^"_RESULT
+11 SET ^TMP("ORWGRPC DC",$JOB,RESULT)=""
End DoDot:1
+12 SET RESULT=""
+13 FOR
SET RESULT=$ORDER(^TMP("ORWGRPC DC",$JOB,RESULT))
if RESULT=""
QUIT
SET CNT=CNT+1
Begin DoDot:1
+14 DO SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
End DoDot:1
+15 KILL ^TMP("ORWGRPC DC",$JOB)
+16 QUIT
+17 ;
