- 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 Feb 19, 2025@00:02:44 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 ;