Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORWGAPI2

ORWGAPI2.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ADVERSE(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
  1. N DATE,IEN,ITEM,RESULT
  1. K ^TMP("ORWGRPC SORT",$J),^TMP("ORWGRPC TEMP",$J)
  1. S IEN=0
  1. F S IEN=$O(^GMR(120.8,"B",DFN,IEN)) Q:IEN<1 D
  1. . I '$D(^GMR(120.8,IEN,0)) Q
  1. . I $G(^GMR(120.8,IEN,"ER")) Q
  1. . I '$P(^GMR(120.8,IEN,0),U,12) Q
  1. . S DATE=+$P($G(^GMR(120.8,IEN,0)),U,4) I 'DATE Q
  1. . S ITEM=$P(^GMR(120.8,IEN,0),U,2) I '$L(ITEM) Q
  1. . S ^TMP("ORWGRPC SORT",$J,DATE,ITEM)="" ;ADVERSE
  1. I FMT=6 D
  1. . S DATE=OLDEST
  1. . F S DATE=$O(^TMP("ORWGRPC SORT",$J,DATE)) Q:DATE<1 Q:DATE>NEWEST D
  1. .. S ITEM=""
  1. .. F S ITEM=$O(^TMP("ORWGRPC SORT",$J,DATE,ITEM)) Q:ITEM="" D
  1. ... I $D(^TMP("ORWGRPC TEMP",$J,ITEM)) Q
  1. ... S ^TMP("ORWGRPC TEMP",$J,ITEM)=""
  1. ... S CNT=CNT+1
  1. ... S RESULT="120.8^"_ITEM
  1. ... D SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
  1. I FMT'=6 D
  1. . S DATE=0
  1. . F S DATE=$O(^TMP("ORWGRPC SORT",$J,DATE)) Q:DATE<1 D
  1. .. S ITEM=""
  1. .. F S ITEM=$O(^TMP("ORWGRPC SORT",$J,DATE,ITEM)) Q:ITEM="" D
  1. ... I $D(^TMP("ORWGRPC TEMP",$J,ITEM)) Q
  1. ... S ^TMP("ORWGRPC TEMP",$J,ITEM)=""
  1. ... S CNT=CNT+1
  1. ... I FMT=3 S RESULT="120.8^"_ITEM_"^^"_ITEM_"^^"_DATE
  1. ... I FMT=0 S RESULT="120.8^"_ITEM_U_ITEM
  1. ... D SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
  1. K ^TMP("ORWGRPC SORT",$J),^TMP("ORWGRPC TEMP",$J)
  1. Q
  1. ;
  1. PL(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
  1. N DATE,ICD9,OK,PRIORITY,RESULT,STATUS
  1. K ^TMP("ORWGRPC TEMP",$J)
  1. S STATUS=""
  1. F S STATUS=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS)) Q:STATUS="" D
  1. . S PRIORITY=""
  1. . F S PRIORITY=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY)) Q:PRIORITY="" D
  1. .. S ICD9=""
  1. .. F S ICD9=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ICD9)) Q:ICD9="" D
  1. ... S OK=0
  1. ... I FMT=6 D
  1. .... S DATE=OLDEST
  1. .... F S DATE=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ICD9,DATE)) Q:DATE="" Q:DATE>NEWEST D Q:OK
  1. ..... S CNT=CNT+1
  1. ..... S OK=1
  1. ..... S RESULT=9000011_U_ICD9
  1. ... I FMT=3 D
  1. .... S DATE=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ICD9,""),-1)
  1. .... I DATE S ^TMP("ORWGRPC TEMP",$J,ICD9,DATE)=""
  1. ... I FMT=0 D
  1. .... S CNT=CNT+1
  1. .... S OK=1
  1. .... S RESULT=9000011_U_ICD9_U_$$EVALUE^ORWGAPIU(ICD9,9000011,.01)
  1. ... I OK D SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
  1. I FMT=3 D
  1. . S ICD9=""
  1. . F S ICD9=$O(^TMP("ORWGRPC TEMP",$J,ICD9)) Q:ICD9="" D
  1. .. S DATE=$O(^TMP("ORWGRPC TEMP",$J,ICD9,""),-1)
  1. .. I 'DATE Q
  1. .. S CNT=CNT+1
  1. .. S RESULT=9000011_U_ICD9_"^^"_$$EVALUE^ORWGAPIU(ICD9,9000011,.01)_"^^"_DATE
  1. .. D SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
  1. K ^TMP("ORWGRPC TEMP",$J)
  1. Q
  1. ;
  1. PLX(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
  1. D PLX2^ORWGAPID(.ITEMS,DFN,FMT,OLDEST,NEWEST,.CNT,.TMP)
  1. Q
  1. ;
  1. REG(ITEMS,DFN,FILE,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
  1. N DATE,ICD,ITEM,NUM,OK,RESULT
  1. K ^TMP("ORWGRPC TEMP",$J)
  1. I $E(FILE,3,4)="DX" S ICD="ICD9"
  1. I $E(FILE,3,4)="OP" S ICD="ICD0"
  1. S NUM=""
  1. F S NUM=$O(^PXRMINDX(45,ICD,"PNI",DFN,NUM)) Q:NUM="" D
  1. . S ITEM=""
  1. . F S ITEM=$O(^PXRMINDX(45,ICD,"PNI",DFN,NUM,ITEM)) Q:ITEM="" D
  1. .. S OK=0
  1. .. I FMT=6 D
  1. ... S DATE=OLDEST
  1. ... F S DATE=$O(^PXRMINDX(45,ICD,"PNI",DFN,NUM,ITEM,DATE)) Q:DATE="" Q:DATE>NEWEST D Q:OK
  1. .... S CNT=CNT+1
  1. .... S OK=1
  1. .... S RESULT=FILE_U_ITEM
  1. .. I FMT=3 D
  1. ... S DATE=$O(^PXRMINDX(45,ICD,"PNI",DFN,NUM,ITEM,""),-1)
  1. ... I DATE S ^TMP("ORWGRPC TEMP",$J,ITEM,DATE)=""
  1. .. I FMT=0 D
  1. ... S CNT=CNT+1
  1. ... S OK=1
  1. ... S RESULT=FILE_U_ITEM_U_$$EVALUE^ORWGAPIU(ITEM,45_";"_ICD,.01)
  1. .. I OK D SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
  1. I FMT=3 D
  1. . S ITEM=""
  1. . F S ITEM=$O(^TMP("ORWGRPC TEMP",$J,ITEM)) Q:ITEM="" D
  1. .. S DATE=$O(^TMP("ORWGRPC TEMP",$J,ITEM,""),-1)
  1. .. I 'DATE Q
  1. .. S CNT=CNT+1
  1. .. S RESULT=FILE_U_ITEM_"^^"_$$EVALUE^ORWGAPIU(ITEM,45_";"_ICD,.01)_"^^"_DATE
  1. .. D SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
  1. K ^TMP("ORWGRPC TEMP",$J)
  1. Q
  1. ;