ORWGAPI2 ; SLC/STAFF - Graph API Items ;12/21/05 08:16
;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,243**;Dec 17, 1997;Build 242
;
ADVERSE(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
N DATE,IEN,ITEM,RESULT
K ^TMP("ORWGRPC SORT",$J),^TMP("ORWGRPC TEMP",$J)
S IEN=0
F S IEN=$O(^GMR(120.8,"B",DFN,IEN)) Q:IEN<1 D
. I '$D(^GMR(120.8,IEN,0)) Q
. I $G(^GMR(120.8,IEN,"ER")) Q
. I '$P(^GMR(120.8,IEN,0),U,12) Q
. S DATE=+$P($G(^GMR(120.8,IEN,0)),U,4) I 'DATE Q
. S ITEM=$P(^GMR(120.8,IEN,0),U,2) I '$L(ITEM) Q
. S ^TMP("ORWGRPC SORT",$J,DATE,ITEM)="" ;ADVERSE
I FMT=6 D
. S DATE=OLDEST
. F S DATE=$O(^TMP("ORWGRPC SORT",$J,DATE)) Q:DATE<1 Q:DATE>NEWEST D
.. S ITEM=""
.. F S ITEM=$O(^TMP("ORWGRPC SORT",$J,DATE,ITEM)) Q:ITEM="" D
... I $D(^TMP("ORWGRPC TEMP",$J,ITEM)) Q
... S ^TMP("ORWGRPC TEMP",$J,ITEM)=""
... S CNT=CNT+1
... S RESULT="120.8^"_ITEM
... D SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
I FMT'=6 D
. S DATE=0
. F S DATE=$O(^TMP("ORWGRPC SORT",$J,DATE)) Q:DATE<1 D
.. S ITEM=""
.. F S ITEM=$O(^TMP("ORWGRPC SORT",$J,DATE,ITEM)) Q:ITEM="" D
... I $D(^TMP("ORWGRPC TEMP",$J,ITEM)) Q
... S ^TMP("ORWGRPC TEMP",$J,ITEM)=""
... S CNT=CNT+1
... I FMT=3 S RESULT="120.8^"_ITEM_"^^"_ITEM_"^^"_DATE
... I FMT=0 S RESULT="120.8^"_ITEM_U_ITEM
... D SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
K ^TMP("ORWGRPC SORT",$J),^TMP("ORWGRPC TEMP",$J)
Q
;
PL(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
N DATE,ICD9,OK,PRIORITY,RESULT,STATUS
K ^TMP("ORWGRPC TEMP",$J)
S STATUS=""
F S STATUS=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS)) Q:STATUS="" D
. S PRIORITY=""
. F S PRIORITY=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY)) Q:PRIORITY="" D
.. S ICD9=""
.. F S ICD9=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ICD9)) Q:ICD9="" D
... S OK=0
... I FMT=6 D
.... S DATE=OLDEST
.... F S DATE=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ICD9,DATE)) Q:DATE="" Q:DATE>NEWEST D Q:OK
..... S CNT=CNT+1
..... S OK=1
..... S RESULT=9000011_U_ICD9
... I FMT=3 D
.... S DATE=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ICD9,""),-1)
.... I DATE S ^TMP("ORWGRPC TEMP",$J,ICD9,DATE)=""
... I FMT=0 D
.... S CNT=CNT+1
.... S OK=1
.... S RESULT=9000011_U_ICD9_U_$$EVALUE^ORWGAPIU(ICD9,9000011,.01)
... I OK D SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
I FMT=3 D
. S ICD9=""
. F S ICD9=$O(^TMP("ORWGRPC TEMP",$J,ICD9)) Q:ICD9="" D
.. S DATE=$O(^TMP("ORWGRPC TEMP",$J,ICD9,""),-1)
.. I 'DATE Q
.. S CNT=CNT+1
.. S RESULT=9000011_U_ICD9_"^^"_$$EVALUE^ORWGAPIU(ICD9,9000011,.01)_"^^"_DATE
.. D SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
K ^TMP("ORWGRPC TEMP",$J)
Q
;
PLX(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
D PLX2^ORWGAPID(.ITEMS,DFN,FMT,OLDEST,NEWEST,.CNT,.TMP)
Q
;
REG(ITEMS,DFN,FILE,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
N DATE,ICD,ITEM,NUM,OK,RESULT
K ^TMP("ORWGRPC TEMP",$J)
I $E(FILE,3,4)="DX" S ICD="ICD9"
I $E(FILE,3,4)="OP" S ICD="ICD0"
S NUM=""
F S NUM=$O(^PXRMINDX(45,ICD,"PNI",DFN,NUM)) Q:NUM="" D
. S ITEM=""
. F S ITEM=$O(^PXRMINDX(45,ICD,"PNI",DFN,NUM,ITEM)) Q:ITEM="" D
.. S OK=0
.. I FMT=6 D
... S DATE=OLDEST
... F S DATE=$O(^PXRMINDX(45,ICD,"PNI",DFN,NUM,ITEM,DATE)) Q:DATE="" Q:DATE>NEWEST D Q:OK
.... S CNT=CNT+1
.... S OK=1
.... S RESULT=FILE_U_ITEM
.. I FMT=3 D
... S DATE=$O(^PXRMINDX(45,ICD,"PNI",DFN,NUM,ITEM,""),-1)
... I DATE S ^TMP("ORWGRPC TEMP",$J,ITEM,DATE)=""
.. I FMT=0 D
... S CNT=CNT+1
... S OK=1
... S RESULT=FILE_U_ITEM_U_$$EVALUE^ORWGAPIU(ITEM,45_";"_ICD,.01)
.. I OK D SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
I FMT=3 D
. S ITEM=""
. F S ITEM=$O(^TMP("ORWGRPC TEMP",$J,ITEM)) Q:ITEM="" D
.. S DATE=$O(^TMP("ORWGRPC TEMP",$J,ITEM,""),-1)
.. I 'DATE Q
.. S CNT=CNT+1
.. S RESULT=FILE_U_ITEM_"^^"_$$EVALUE^ORWGAPIU(ITEM,45_";"_ICD,.01)_"^^"_DATE
.. D SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
K ^TMP("ORWGRPC TEMP",$J)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWGAPI2 4004 printed Oct 16, 2024@18:36:46 Page 2
ORWGAPI2 ; SLC/STAFF - Graph API Items ;12/21/05 08:16
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,243**;Dec 17, 1997;Build 242
+2 ;
ADVERSE(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
+1 NEW DATE,IEN,ITEM,RESULT
+2 KILL ^TMP("ORWGRPC SORT",$JOB),^TMP("ORWGRPC TEMP",$JOB)
+3 SET IEN=0
+4 FOR
SET IEN=$ORDER(^GMR(120.8,"B",DFN,IEN))
if IEN<1
QUIT
Begin DoDot:1
+5 IF '$DATA(^GMR(120.8,IEN,0))
QUIT
+6 IF $GET(^GMR(120.8,IEN,"ER"))
QUIT
+7 IF '$PIECE(^GMR(120.8,IEN,0),U,12)
QUIT
+8 SET DATE=+$PIECE($GET(^GMR(120.8,IEN,0)),U,4)
IF 'DATE
QUIT
+9 SET ITEM=$PIECE(^GMR(120.8,IEN,0),U,2)
IF '$LENGTH(ITEM)
QUIT
+10 ;ADVERSE
SET ^TMP("ORWGRPC SORT",$JOB,DATE,ITEM)=""
End DoDot:1
+11 IF FMT=6
Begin DoDot:1
+12 SET DATE=OLDEST
+13 FOR
SET DATE=$ORDER(^TMP("ORWGRPC SORT",$JOB,DATE))
if DATE<1
QUIT
if DATE>NEWEST
QUIT
Begin DoDot:2
+14 SET ITEM=""
+15 FOR
SET ITEM=$ORDER(^TMP("ORWGRPC SORT",$JOB,DATE,ITEM))
if ITEM=""
QUIT
Begin DoDot:3
+16 IF $DATA(^TMP("ORWGRPC TEMP",$JOB,ITEM))
QUIT
+17 SET ^TMP("ORWGRPC TEMP",$JOB,ITEM)=""
+18 SET CNT=CNT+1
+19 SET RESULT="120.8^"_ITEM
+20 DO SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
End DoDot:3
End DoDot:2
End DoDot:1
+21 IF FMT'=6
Begin DoDot:1
+22 SET DATE=0
+23 FOR
SET DATE=$ORDER(^TMP("ORWGRPC SORT",$JOB,DATE))
if DATE<1
QUIT
Begin DoDot:2
+24 SET ITEM=""
+25 FOR
SET ITEM=$ORDER(^TMP("ORWGRPC SORT",$JOB,DATE,ITEM))
if ITEM=""
QUIT
Begin DoDot:3
+26 IF $DATA(^TMP("ORWGRPC TEMP",$JOB,ITEM))
QUIT
+27 SET ^TMP("ORWGRPC TEMP",$JOB,ITEM)=""
+28 SET CNT=CNT+1
+29 IF FMT=3
SET RESULT="120.8^"_ITEM_"^^"_ITEM_"^^"_DATE
+30 IF FMT=0
SET RESULT="120.8^"_ITEM_U_ITEM
+31 DO SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
End DoDot:3
End DoDot:2
End DoDot:1
+32 KILL ^TMP("ORWGRPC SORT",$JOB),^TMP("ORWGRPC TEMP",$JOB)
+33 QUIT
+34 ;
PL(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
+1 NEW DATE,ICD9,OK,PRIORITY,RESULT,STATUS
+2 KILL ^TMP("ORWGRPC TEMP",$JOB)
+3 SET STATUS=""
+4 FOR
SET STATUS=$ORDER(^PXRMINDX(9000011,"PSPI",DFN,STATUS))
if STATUS=""
QUIT
Begin DoDot:1
+5 SET PRIORITY=""
+6 FOR
SET PRIORITY=$ORDER(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY))
if PRIORITY=""
QUIT
Begin DoDot:2
+7 SET ICD9=""
+8 FOR
SET ICD9=$ORDER(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ICD9))
if ICD9=""
QUIT
Begin DoDot:3
+9 SET OK=0
+10 IF FMT=6
Begin DoDot:4
+11 SET DATE=OLDEST
+12 FOR
SET DATE=$ORDER(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ICD9,DATE))
if DATE=""
QUIT
if DATE>NEWEST
QUIT
Begin DoDot:5
+13 SET CNT=CNT+1
+14 SET OK=1
+15 SET RESULT=9000011_U_ICD9
End DoDot:5
if OK
QUIT
End DoDot:4
+16 IF FMT=3
Begin DoDot:4
+17 SET DATE=$ORDER(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ICD9,""),-1)
+18 IF DATE
SET ^TMP("ORWGRPC TEMP",$JOB,ICD9,DATE)=""
End DoDot:4
+19 IF FMT=0
Begin DoDot:4
+20 SET CNT=CNT+1
+21 SET OK=1
+22 SET RESULT=9000011_U_ICD9_U_$$EVALUE^ORWGAPIU(ICD9,9000011,.01)
End DoDot:4
+23 IF OK
DO SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
End DoDot:3
End DoDot:2
End DoDot:1
+24 IF FMT=3
Begin DoDot:1
+25 SET ICD9=""
+26 FOR
SET ICD9=$ORDER(^TMP("ORWGRPC TEMP",$JOB,ICD9))
if ICD9=""
QUIT
Begin DoDot:2
+27 SET DATE=$ORDER(^TMP("ORWGRPC TEMP",$JOB,ICD9,""),-1)
+28 IF 'DATE
QUIT
+29 SET CNT=CNT+1
+30 SET RESULT=9000011_U_ICD9_"^^"_$$EVALUE^ORWGAPIU(ICD9,9000011,.01)_"^^"_DATE
+31 DO SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
End DoDot:2
End DoDot:1
+32 KILL ^TMP("ORWGRPC TEMP",$JOB)
+33 QUIT
+34 ;
PLX(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
+1 DO PLX2^ORWGAPID(.ITEMS,DFN,FMT,OLDEST,NEWEST,.CNT,.TMP)
+2 QUIT
+3 ;
REG(ITEMS,DFN,FILE,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
+1 NEW DATE,ICD,ITEM,NUM,OK,RESULT
+2 KILL ^TMP("ORWGRPC TEMP",$JOB)
+3 IF $EXTRACT(FILE,3,4)="DX"
SET ICD="ICD9"
+4 IF $EXTRACT(FILE,3,4)="OP"
SET ICD="ICD0"
+5 SET NUM=""
+6 FOR
SET NUM=$ORDER(^PXRMINDX(45,ICD,"PNI",DFN,NUM))
if NUM=""
QUIT
Begin DoDot:1
+7 SET ITEM=""
+8 FOR
SET ITEM=$ORDER(^PXRMINDX(45,ICD,"PNI",DFN,NUM,ITEM))
if ITEM=""
QUIT
Begin DoDot:2
+9 SET OK=0
+10 IF FMT=6
Begin DoDot:3
+11 SET DATE=OLDEST
+12 FOR
SET DATE=$ORDER(^PXRMINDX(45,ICD,"PNI",DFN,NUM,ITEM,DATE))
if DATE=""
QUIT
if DATE>NEWEST
QUIT
Begin DoDot:4
+13 SET CNT=CNT+1
+14 SET OK=1
+15 SET RESULT=FILE_U_ITEM
End DoDot:4
if OK
QUIT
End DoDot:3
+16 IF FMT=3
Begin DoDot:3
+17 SET DATE=$ORDER(^PXRMINDX(45,ICD,"PNI",DFN,NUM,ITEM,""),-1)
+18 IF DATE
SET ^TMP("ORWGRPC TEMP",$JOB,ITEM,DATE)=""
End DoDot:3
+19 IF FMT=0
Begin DoDot:3
+20 SET CNT=CNT+1
+21 SET OK=1
+22 SET RESULT=FILE_U_ITEM_U_$$EVALUE^ORWGAPIU(ITEM,45_";"_ICD,.01)
End DoDot:3
+23 IF OK
DO SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
End DoDot:2
End DoDot:1
+24 IF FMT=3
Begin DoDot:1
+25 SET ITEM=""
+26 FOR
SET ITEM=$ORDER(^TMP("ORWGRPC TEMP",$JOB,ITEM))
if ITEM=""
QUIT
Begin DoDot:2
+27 SET DATE=$ORDER(^TMP("ORWGRPC TEMP",$JOB,ITEM,""),-1)
+28 IF 'DATE
QUIT
+29 SET CNT=CNT+1
+30 SET RESULT=FILE_U_ITEM_"^^"_$$EVALUE^ORWGAPIU(ITEM,45_";"_ICD,.01)_"^^"_DATE
+31 DO SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
End DoDot:2
End DoDot:1
+32 KILL ^TMP("ORWGRPC TEMP",$JOB)
+33 QUIT
+34 ;
