- ORWGAPID ; SLC/STAFF - Graph API Details ;12/21/05 08:19
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,243**;Dec 17, 1997;Build 242
- ;
- DETAILS(DATA,DFN,DATE1,DATE2,FILEITEM) ; from ORWGAPI (series click)
- N ITEM,FILE,SUBHEAD,TYPEITEM K SUBHEAD,TYPEITEM
- K ^TMP("LR7OGX",$J),^TMP("LRC",$J)
- K ^TMP("ORLRC",$J),^TMP("PSBO",$J),^TMP("TIUVIEW",$J)
- S FILE=$P(FILEITEM,U)
- S ITEM=$$UP^ORWGAPIX($P(FILEITEM,U,2))
- I '$L(ITEM) Q
- D
- . I FILE=63 D Q
- .. D INTERIM^ORWLRR(.DATA,DFN,DATE1,DATE2)
- .. M ^TMP("ORWGRPC",$J)=^TMP("LR7OGX",$J,"OUTPUT")
- . I FILE="63MI" D Q
- .. D MICRO^ORWLRR(.DATA,DFN,DATE1,DATE2)
- .. M ^TMP("ORWGRPC",$J)=^TMP("LR7OGX",$J,"OUTPUT")
- . I FILE="63AP" D Q
- .. S SUBHEAD("CYTOPATHOLOGY")=""
- .. S SUBHEAD("SURGICAL PATHOLOGY")=""
- .. S SUBHEAD("EM")=""
- .. S SUBHEAD("AUTOPSY")=""
- .. D LABSUM^ORWGAPIC(.DATA,DFN,DATE1,DATE2,.SUBHEAD)
- .. M ^TMP("ORWGRPC",$J)=^TMP("LRC",$J)
- . I FILE="63BB" D Q
- .. D BLR^ORWRP1(.DATA,DFN,"",DATE1,DATE2)
- .. M ^TMP("ORWGRPC",$J)=^TMP("ORLRC",$J)
- . I FILE="53.79" D Q
- .. ;D BCMA1^ORWRP1A(.DATA,DFN,"",DATE1,DATE2) ***** BA 12/14/07
- .. D BCMA1^ORWRP1A(.DATA,DFN,"",DATE2,DATE1)
- .. M ^TMP("ORWGRPC",$J)=^TMP("PSBO",$J)
- . I FILE="8925" D Q
- .. D NOTE(.DATA,DFN,DATE1,DATE2,ITEM)
- .. ;M ^TMP("ORWGRPC",$J)=^TMP("TIUVIEW",$J)
- . S TYPEITEM(1)=FILE_"^0"
- . D DETAIL(.DATA,DFN,DATE1,DATE2,.TYPEITEM)
- K ^TMP("LR7OGX",$J),^TMP("LRC",$J)
- K ^TMP("ORLRC",$J),^TMP("PSBO",$J),^TMP("TIUVIEW",$J)
- Q
- ;
- DETAIL(DATA,DFN,DATE1,DATE2,TYPEITEM) ; from ORWGAPI (legend click)
- N CNT,FILE,GMTSPX1,GMTSPX2,ITEM,TITEMS,TYPE
- N COMP,NEWITEMS K COMP,NEWITEMS
- K ^TMP("ORDATA",$J)
- S DFN=+$G(DFN) I 'DFN Q
- I '$L($O(TYPEITEM(0))) Q
- S TYPE=""
- F S TYPE=$O(TYPEITEM(TYPE)) Q:TYPE="" D
- . S TITEMS=TYPEITEM(TYPE)
- . S FILE=$P(TITEMS,U) I '$L(FILE) Q
- . S ITEM=$P(TITEMS,U,2) I '$L(ITEM) Q
- . S NEWITEMS(FILE,ITEM)=""
- S CNT=0
- S FILE=""
- F S FILE=$O(NEWITEMS(FILE)) Q:FILE="" D
- . S CNT=CNT+1
- . S COMP(CNT)=$$COMPTYPE^ORWGAPIT(FILE)
- S GMTSPX1=DATE1,GMTSPX2=DATE2
- D REPORT^ORWRP2(.DATA,.COMP,DFN)
- M ^TMP("ORWGRPC",$J)=^TMP("ORDATA",$J)
- ;K ^TMP("ORDATA",$J)
- ;Q
- ;
- S CNT=0
- S TYPE=""
- F S TYPE=$O(TYPEITEM(TYPE)) Q:TYPE="" D
- . S TITEMS=TYPEITEM(TYPE)
- . S CNT=CNT+1
- . S ^TMP("ORWGRPC",$J,CNT/10000)="~~~^"_TITEMS
- ;
- K ^TMP("ORDATA",$J)
- Q
- ;
- GETDATES(DATA,REPORTID) ; from ORWGAPI
- N DAT,TMP K DAT
- D RETURN^ORWGAPIW(.TMP,.DATA)
- S DAT(1)="S^Date Range..."
- S DAT(2)="1^Today"
- S DAT(3)="2^One Week"
- S DAT(4)="3^Two Weeks"
- S DAT(5)="4^One Month"
- S DAT(6)="5^Six Months"
- S DAT(7)="6^One Year"
- S DAT(8)="7^Two Years"
- S DAT(9)="8^All Results"
- D DATES^ORWGAPIP(.DAT,REPORTID)
- I TMP M ^TMP(DATA,$J)=DAT
- I 'TMP M DATA=DAT
- Q
- ;
- NOTE(DATA,DFN,DATE1,DATE2,ITEM) ;
- N CNT,DATE,DOC,DOCCLASS,DOCTYPE,DUM,IEN,LINE,NUM,RESULTS K DUM
- K ^TMP("TIUR",$J),^TMP("TIUVIEW",$J)
- S CNT=$G(CNT)
- F DOCTYPE="P","D","C" D
- . S DOCCLASS=$$DOCCLASS^ORWGAPIA(DOCTYPE)
- . K ^TMP("TIUR",$J)
- . D TIU^ORWGAPIA(.DUM,DOCCLASS,5,DFN,DATE1,DATE2)
- . S DOC=0
- . F S DOC=$O(^TMP("TIUR",$J,DOC)) Q:DOC<1 D
- .. S RESULTS=^TMP("TIUR",$J,DOC)
- .. S IEN=+$P(RESULTS,U)
- .. K ^TMP("TIUVIEW",$J)
- .. D GETTIU^ORWGAPIA(.DATA,IEN)
- .. S NUM=0
- .. F S NUM=$O(^TMP("TIUVIEW",$J,NUM)) Q:NUM<1 D
- ... S LINE=$G(^TMP("TIUVIEW",$J,NUM))
- ... S CNT=CNT+1
- ... S ^TMP("ORWGRPC",$J,CNT)=LINE
- .. I CNT>1 D
- ... S CNT=CNT+1
- ... S ^TMP("ORWGRPC",$J,CNT)=" "
- ... S CNT=CNT+1
- ... S ^TMP("ORWGRPC",$J,CNT)=" "
- ... S ^TMP("ORWGRPC",$J,CNT/10000)="~~~^"_^TMP("TIUR",$J,DOC)
- K ^TMP("TIUR",$J),^TMP("TIUVIEW",$J)
- Q
- ;
- TAX(DATA,ALL,REMTAX) ; from ORWGAPI
- N CNT,REM,CODE,NUM,TMP
- K ^TMP("ORWG TEMP",$J)
- D RETURN^ORWGAPIW(.TMP,.DATA)
- S CNT=0
- S REM=0
- I ALL F S REM=$O(^PXD(811.2,REM)) Q:REM<1 D TEMP(REM)
- I 'ALL D
- . S NUM=0
- . F S NUM=$O(REMTAX(NUM)) Q:NUM<1 D
- .. S REM=REMTAX(NUM)
- .. D TEMP(REM)
- S CODE=""
- F S CODE=$O(^TMP("ORWG TEMP",$J,CODE)) Q:CODE="" D
- . D SETUP^ORWGAPIW(.DATA,CODE,TMP,.CNT)
- K ^TMP("ORWG TEMP",$J)
- Q
- ;
- TEMP(REM) ;
- N NODE,NUM,SUB
- I $P($G(^PXD(811.2,REM,0)),U,6)=1 Q
- F SUB=80,80.1,81 D
- . S NUM=0
- . F S NUM=$O(^PXD(811.3,REM,SUB,NUM)) Q:NUM<1 D
- .. S NODE=+$G(^PXD(811.3,REM,SUB,NUM,0))
- .. I 'NODE Q
- .. I SUB=80 D Q
- ... S ^TMP("ORWG TEMP",$J,"45DX;"_NODE)=""
- ... S ^TMP("ORWG TEMP",$J,"9000010.07;"_NODE)=""
- ... S ^TMP("ORWG TEMP",$J,"9000011;"_NODE)=""
- .. I SUB=80.1 D Q
- ... S ^TMP("ORWG TEMP",$J,"45OP;"_NODE)=""
- .. I SUB=81 D Q
- ... S ^TMP("ORWG TEMP",$J,"9000010.18;"_NODE)=""
- Q
- ;
- PLX2(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
- N DATE,DTONSET,DTPLUS1,DTRESOLV,NODE,PRIORITY,PROB,PROBDX,PSTATUS,RESULT,STATUS,VALUE
- K ^TMP("ORWGRPC TEMP",$J)
- S DTPLUS1=$$FMADD^ORWGAPIX(DT,1)
- 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 ITEM=""
- .. F S ITEM=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ITEM)) Q:ITEM="" D
- ... S DATE=""
- ... F S DATE=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE)) Q:DATE="" D
- .... S NODE=""
- .... F S NODE=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE,NODE)) Q:NODE="" D
- ..... D PROB^ORWGAPIA(.PROB,.PSTATUS,.PROBDX,.DTONSET,.DTRESOLV,NODE)
- ..... I 'DTRESOLV S ^TMP("ORWGRPC TEMP",$J,PROBDX,DTONSET)=DTPLUS1 Q
- ..... S ^TMP("ORWGRPC TEMP",$J,PROBDX,DTONSET)=DTRESOLV
- S PROB=""
- F S PROB=$O(^TMP("ORWGRPC TEMP",$J,PROB)) Q:PROB="" D
- . S VALUE=$$EVALUE^ORWGAPIU(PROB,9000011,.01)
- . I FMT=0 D
- .. S CNT=CNT+1
- .. S RESULT=9999911_U_PROB_U_VALUE
- .. D SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
- . I FMT=6 D
- .. S OK=0
- .. S DATE=0
- .. F S DATE=$O(^TMP("ORWGRPC TEMP",$J,PROB,DATE)) Q:DATE="" Q:DATE>NEWEST D Q:OK
- ... S DTRESOLV=^TMP("ORWGRPC TEMP",$J,PROB,DATE)
- ... I DTRESOLV<OLDEST Q
- ... S CNT=CNT+1
- ... S OK=1
- ... S RESULT=9999911_U_PROB
- .. I OK D SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
- . I FMT=3 D
- .. S DATE=$O(^TMP("ORWGRPC TEMP",$J,PROB,""),-1)
- .. I 'DATE Q
- .. S CNT=CNT+1
- .. S RESULT=9999911_U_PROB_"^^"_VALUE_"^^"_DATE
- .. D SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
- K ^TMP("ORWGRPC TEMP",$J)
- Q
- ;
- PROBX4(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
- N DATE,DTONSET,DTPLUS1,DTRESOLV,NODE,PRIORITY,PROB,PROBDX,PSTATUS,RESULT,STATUS,VALUE
- K ^TMP("ORWGRPC TEMP",$J)
- S CNT=$G(CNT),DTPLUS1=$$FMADD^ORWGAPIX(DT,1)
- 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 DATE=""
- .. F S DATE=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE)) Q:DATE="" D
- ... I DATE>START Q
- ... S NODE=""
- ... F S NODE=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE,NODE)) Q:NODE="" D
- .... S ^TMP("ORWGRPC TEMP",$J,NODE)=""
- S NODE=""
- F S NODE=$O(^TMP("ORWGRPC TEMP",$J,NODE)) Q:NODE="" D
- . D PROB^ORWGAPIA(.PROB,.PSTATUS,.PROBDX,.DTONSET,.DTRESOLV,NODE)
- . I 'DTONSET Q
- . I 'DTRESOLV S DTRESOLV=DTPLUS1
- . S RESULT=9999911_U_PROBDX_U_DTONSET_U_DTRESOLV_U_$$EXT^ORWGAPIX(PSTATUS,9000011,.12)
- . D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
- K ^TMP("ORWGRPC TEMP",$J)
- Q
- ;
- ORWGAPID ; SLC/STAFF - Graph API Details ;12/21/05 08:19
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,243**;Dec 17, 1997;Build 242
- +2 ;
- DETAILS(DATA,DFN,DATE1,DATE2,FILEITEM) ; from ORWGAPI (series click)
- +1 NEW ITEM,FILE,SUBHEAD,TYPEITEM
- KILL SUBHEAD,TYPEITEM
- +2 KILL ^TMP("LR7OGX",$JOB),^TMP("LRC",$JOB)
- +3 KILL ^TMP("ORLRC",$JOB),^TMP("PSBO",$JOB),^TMP("TIUVIEW",$JOB)
- +4 SET FILE=$PIECE(FILEITEM,U)
- +5 SET ITEM=$$UP^ORWGAPIX($PIECE(FILEITEM,U,2))
- +6 IF '$LENGTH(ITEM)
- QUIT
- +7 Begin DoDot:1
- +8 IF FILE=63
- Begin DoDot:2
- +9 DO INTERIM^ORWLRR(.DATA,DFN,DATE1,DATE2)
- +10 MERGE ^TMP("ORWGRPC",$JOB)=^TMP("LR7OGX",$JOB,"OUTPUT")
- End DoDot:2
- QUIT
- +11 IF FILE="63MI"
- Begin DoDot:2
- +12 DO MICRO^ORWLRR(.DATA,DFN,DATE1,DATE2)
- +13 MERGE ^TMP("ORWGRPC",$JOB)=^TMP("LR7OGX",$JOB,"OUTPUT")
- End DoDot:2
- QUIT
- +14 IF FILE="63AP"
- Begin DoDot:2
- +15 SET SUBHEAD("CYTOPATHOLOGY")=""
- +16 SET SUBHEAD("SURGICAL PATHOLOGY")=""
- +17 SET SUBHEAD("EM")=""
- +18 SET SUBHEAD("AUTOPSY")=""
- +19 DO LABSUM^ORWGAPIC(.DATA,DFN,DATE1,DATE2,.SUBHEAD)
- +20 MERGE ^TMP("ORWGRPC",$JOB)=^TMP("LRC",$JOB)
- End DoDot:2
- QUIT
- +21 IF FILE="63BB"
- Begin DoDot:2
- +22 DO BLR^ORWRP1(.DATA,DFN,"",DATE1,DATE2)
- +23 MERGE ^TMP("ORWGRPC",$JOB)=^TMP("ORLRC",$JOB)
- End DoDot:2
- QUIT
- +24 IF FILE="53.79"
- Begin DoDot:2
- +25 ;D BCMA1^ORWRP1A(.DATA,DFN,"",DATE1,DATE2) ***** BA 12/14/07
- +26 DO BCMA1^ORWRP1A(.DATA,DFN,"",DATE2,DATE1)
- +27 MERGE ^TMP("ORWGRPC",$JOB)=^TMP("PSBO",$JOB)
- End DoDot:2
- QUIT
- +28 IF FILE="8925"
- Begin DoDot:2
- +29 DO NOTE(.DATA,DFN,DATE1,DATE2,ITEM)
- +30 ;M ^TMP("ORWGRPC",$J)=^TMP("TIUVIEW",$J)
- End DoDot:2
- QUIT
- +31 SET TYPEITEM(1)=FILE_"^0"
- +32 DO DETAIL(.DATA,DFN,DATE1,DATE2,.TYPEITEM)
- End DoDot:1
- +33 KILL ^TMP("LR7OGX",$JOB),^TMP("LRC",$JOB)
- +34 KILL ^TMP("ORLRC",$JOB),^TMP("PSBO",$JOB),^TMP("TIUVIEW",$JOB)
- +35 QUIT
- +36 ;
- DETAIL(DATA,DFN,DATE1,DATE2,TYPEITEM) ; from ORWGAPI (legend click)
- +1 NEW CNT,FILE,GMTSPX1,GMTSPX2,ITEM,TITEMS,TYPE
- +2 NEW COMP,NEWITEMS
- KILL COMP,NEWITEMS
- +3 KILL ^TMP("ORDATA",$JOB)
- +4 SET DFN=+$GET(DFN)
- IF 'DFN
- QUIT
- +5 IF '$LENGTH($ORDER(TYPEITEM(0)))
- QUIT
- +6 SET TYPE=""
- +7 FOR
- SET TYPE=$ORDER(TYPEITEM(TYPE))
- IF TYPE=""
- QUIT
- Begin DoDot:1
- +8 SET TITEMS=TYPEITEM(TYPE)
- +9 SET FILE=$PIECE(TITEMS,U)
- IF '$LENGTH(FILE)
- QUIT
- +10 SET ITEM=$PIECE(TITEMS,U,2)
- IF '$LENGTH(ITEM)
- QUIT
- +11 SET NEWITEMS(FILE,ITEM)=""
- End DoDot:1
- +12 SET CNT=0
- +13 SET FILE=""
- +14 FOR
- SET FILE=$ORDER(NEWITEMS(FILE))
- IF FILE=""
- QUIT
- Begin DoDot:1
- +15 SET CNT=CNT+1
- +16 SET COMP(CNT)=$$COMPTYPE^ORWGAPIT(FILE)
- End DoDot:1
- +17 SET GMTSPX1=DATE1
- SET GMTSPX2=DATE2
- +18 DO REPORT^ORWRP2(.DATA,.COMP,DFN)
- +19 MERGE ^TMP("ORWGRPC",$JOB)=^TMP("ORDATA",$JOB)
- +20 ;K ^TMP("ORDATA",$J)
- +21 ;Q
- +22 ;
- +23 SET CNT=0
- +24 SET TYPE=""
- +25 FOR
- SET TYPE=$ORDER(TYPEITEM(TYPE))
- IF TYPE=""
- QUIT
- Begin DoDot:1
- +26 SET TITEMS=TYPEITEM(TYPE)
- +27 SET CNT=CNT+1
- +28 SET ^TMP("ORWGRPC",$JOB,CNT/10000)="~~~^"_TITEMS
- End DoDot:1
- +29 ;
- +30 KILL ^TMP("ORDATA",$JOB)
- +31 QUIT
- +32 ;
- GETDATES(DATA,REPORTID) ; from ORWGAPI
- +1 NEW DAT,TMP
- KILL DAT
- +2 DO RETURN^ORWGAPIW(.TMP,.DATA)
- +3 SET DAT(1)="S^Date Range..."
- +4 SET DAT(2)="1^Today"
- +5 SET DAT(3)="2^One Week"
- +6 SET DAT(4)="3^Two Weeks"
- +7 SET DAT(5)="4^One Month"
- +8 SET DAT(6)="5^Six Months"
- +9 SET DAT(7)="6^One Year"
- +10 SET DAT(8)="7^Two Years"
- +11 SET DAT(9)="8^All Results"
- +12 DO DATES^ORWGAPIP(.DAT,REPORTID)
- +13 IF TMP
- MERGE ^TMP(DATA,$JOB)=DAT
- +14 IF 'TMP
- MERGE DATA=DAT
- +15 QUIT
- +16 ;
- NOTE(DATA,DFN,DATE1,DATE2,ITEM) ;
- +1 NEW CNT,DATE,DOC,DOCCLASS,DOCTYPE,DUM,IEN,LINE,NUM,RESULTS
- KILL DUM
- +2 KILL ^TMP("TIUR",$JOB),^TMP("TIUVIEW",$JOB)
- +3 SET CNT=$GET(CNT)
- +4 FOR DOCTYPE="P","D","C"
- Begin DoDot:1
- +5 SET DOCCLASS=$$DOCCLASS^ORWGAPIA(DOCTYPE)
- +6 KILL ^TMP("TIUR",$JOB)
- +7 DO TIU^ORWGAPIA(.DUM,DOCCLASS,5,DFN,DATE1,DATE2)
- +8 SET DOC=0
- +9 FOR
- SET DOC=$ORDER(^TMP("TIUR",$JOB,DOC))
- IF DOC<1
- QUIT
- Begin DoDot:2
- +10 SET RESULTS=^TMP("TIUR",$JOB,DOC)
- +11 SET IEN=+$PIECE(RESULTS,U)
- +12 KILL ^TMP("TIUVIEW",$JOB)
- +13 DO GETTIU^ORWGAPIA(.DATA,IEN)
- +14 SET NUM=0
- +15 FOR
- SET NUM=$ORDER(^TMP("TIUVIEW",$JOB,NUM))
- IF NUM<1
- QUIT
- Begin DoDot:3
- +16 SET LINE=$GET(^TMP("TIUVIEW",$JOB,NUM))
- +17 SET CNT=CNT+1
- +18 SET ^TMP("ORWGRPC",$JOB,CNT)=LINE
- End DoDot:3
- +19 IF CNT>1
- Begin DoDot:3
- +20 SET CNT=CNT+1
- +21 SET ^TMP("ORWGRPC",$JOB,CNT)=" "
- +22 SET CNT=CNT+1
- +23 SET ^TMP("ORWGRPC",$JOB,CNT)=" "
- +24 SET ^TMP("ORWGRPC",$JOB,CNT/10000)="~~~^"_^TMP("TIUR",$JOB,DOC)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +25 KILL ^TMP("TIUR",$JOB),^TMP("TIUVIEW",$JOB)
- +26 QUIT
- +27 ;
- TAX(DATA,ALL,REMTAX) ; from ORWGAPI
- +1 NEW CNT,REM,CODE,NUM,TMP
- +2 KILL ^TMP("ORWG TEMP",$JOB)
- +3 DO RETURN^ORWGAPIW(.TMP,.DATA)
- +4 SET CNT=0
- +5 SET REM=0
- +6 IF ALL
- FOR
- SET REM=$ORDER(^PXD(811.2,REM))
- IF REM<1
- QUIT
- DO TEMP(REM)
- +7 IF 'ALL
- Begin DoDot:1
- +8 SET NUM=0
- +9 FOR
- SET NUM=$ORDER(REMTAX(NUM))
- IF NUM<1
- QUIT
- Begin DoDot:2
- +10 SET REM=REMTAX(NUM)
- +11 DO TEMP(REM)
- End DoDot:2
- End DoDot:1
- +12 SET CODE=""
- +13 FOR
- SET CODE=$ORDER(^TMP("ORWG TEMP",$JOB,CODE))
- IF CODE=""
- QUIT
- Begin DoDot:1
- +14 DO SETUP^ORWGAPIW(.DATA,CODE,TMP,.CNT)
- End DoDot:1
- +15 KILL ^TMP("ORWG TEMP",$JOB)
- +16 QUIT
- +17 ;
- TEMP(REM) ;
- +1 NEW NODE,NUM,SUB
- +2 IF $PIECE($GET(^PXD(811.2,REM,0)),U,6)=1
- QUIT
- +3 FOR SUB=80,80.1,81
- Begin DoDot:1
- +4 SET NUM=0
- +5 FOR
- SET NUM=$ORDER(^PXD(811.3,REM,SUB,NUM))
- IF NUM<1
- QUIT
- Begin DoDot:2
- +6 SET NODE=+$GET(^PXD(811.3,REM,SUB,NUM,0))
- +7 IF 'NODE
- QUIT
- +8 IF SUB=80
- Begin DoDot:3
- +9 SET ^TMP("ORWG TEMP",$JOB,"45DX;"_NODE)=""
- +10 SET ^TMP("ORWG TEMP",$JOB,"9000010.07;"_NODE)=""
- +11 SET ^TMP("ORWG TEMP",$JOB,"9000011;"_NODE)=""
- End DoDot:3
- QUIT
- +12 IF SUB=80.1
- Begin DoDot:3
- +13 SET ^TMP("ORWG TEMP",$JOB,"45OP;"_NODE)=""
- End DoDot:3
- QUIT
- +14 IF SUB=81
- Begin DoDot:3
- +15 SET ^TMP("ORWG TEMP",$JOB,"9000010.18;"_NODE)=""
- End DoDot:3
- QUIT
- End DoDot:2
- End DoDot:1
- +16 QUIT
- +17 ;
- PLX2(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
- +1 NEW DATE,DTONSET,DTPLUS1,DTRESOLV,NODE,PRIORITY,PROB,PROBDX,PSTATUS,RESULT,STATUS,VALUE
- +2 KILL ^TMP("ORWGRPC TEMP",$JOB)
- +3 SET DTPLUS1=$$FMADD^ORWGAPIX(DT,1)
- +4 SET STATUS=""
- +5 FOR
- SET STATUS=$ORDER(^PXRMINDX(9000011,"PSPI",DFN,STATUS))
- IF STATUS=""
- QUIT
- Begin DoDot:1
- +6 SET PRIORITY=""
- +7 FOR
- SET PRIORITY=$ORDER(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY))
- IF PRIORITY=""
- QUIT
- Begin DoDot:2
- +8 SET ITEM=""
- +9 FOR
- SET ITEM=$ORDER(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ITEM))
- IF ITEM=""
- QUIT
- Begin DoDot:3
- +10 SET DATE=""
- +11 FOR
- SET DATE=$ORDER(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE))
- IF DATE=""
- QUIT
- Begin DoDot:4
- +12 SET NODE=""
- +13 FOR
- SET NODE=$ORDER(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE,NODE))
- IF NODE=""
- QUIT
- Begin DoDot:5
- +14 DO PROB^ORWGAPIA(.PROB,.PSTATUS,.PROBDX,.DTONSET,.DTRESOLV,NODE)
- +15 IF 'DTRESOLV
- SET ^TMP("ORWGRPC TEMP",$JOB,PROBDX,DTONSET)=DTPLUS1
- QUIT
- +16 SET ^TMP("ORWGRPC TEMP",$JOB,PROBDX,DTONSET)=DTRESOLV
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +17 SET PROB=""
- +18 FOR
- SET PROB=$ORDER(^TMP("ORWGRPC TEMP",$JOB,PROB))
- IF PROB=""
- QUIT
- Begin DoDot:1
- +19 SET VALUE=$$EVALUE^ORWGAPIU(PROB,9000011,.01)
- +20 IF FMT=0
- Begin DoDot:2
- +21 SET CNT=CNT+1
- +22 SET RESULT=9999911_U_PROB_U_VALUE
- +23 DO SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
- End DoDot:2
- +24 IF FMT=6
- Begin DoDot:2
- +25 SET OK=0
- +26 SET DATE=0
- +27 FOR
- SET DATE=$ORDER(^TMP("ORWGRPC TEMP",$JOB,PROB,DATE))
- IF DATE=""
- QUIT
- IF DATE>NEWEST
- QUIT
- Begin DoDot:3
- +28 SET DTRESOLV=^TMP("ORWGRPC TEMP",$JOB,PROB,DATE)
- +29 IF DTRESOLV<OLDEST
- QUIT
- +30 SET CNT=CNT+1
- +31 SET OK=1
- +32 SET RESULT=9999911_U_PROB
- End DoDot:3
- IF OK
- QUIT
- +33 IF OK
- DO SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
- End DoDot:2
- +34 IF FMT=3
- Begin DoDot:2
- +35 SET DATE=$ORDER(^TMP("ORWGRPC TEMP",$JOB,PROB,""),-1)
- +36 IF 'DATE
- QUIT
- +37 SET CNT=CNT+1
- +38 SET RESULT=9999911_U_PROB_"^^"_VALUE_"^^"_DATE
- +39 DO SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
- End DoDot:2
- End DoDot:1
- +40 KILL ^TMP("ORWGRPC TEMP",$JOB)
- +41 QUIT
- +42 ;
- PROBX4(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
- +1 NEW DATE,DTONSET,DTPLUS1,DTRESOLV,NODE,PRIORITY,PROB,PROBDX,PSTATUS,RESULT,STATUS,VALUE
- +2 KILL ^TMP("ORWGRPC TEMP",$JOB)
- +3 SET CNT=$GET(CNT)
- SET DTPLUS1=$$FMADD^ORWGAPIX(DT,1)
- +4 SET STATUS=""
- +5 FOR
- SET STATUS=$ORDER(^PXRMINDX(9000011,"PSPI",DFN,STATUS))
- IF STATUS=""
- QUIT
- Begin DoDot:1
- +6 SET PRIORITY=""
- +7 FOR
- SET PRIORITY=$ORDER(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY))
- IF PRIORITY=""
- QUIT
- Begin DoDot:2
- +8 SET DATE=""
- +9 FOR
- SET DATE=$ORDER(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE))
- IF DATE=""
- QUIT
- Begin DoDot:3
- +10 IF DATE>START
- QUIT
- +11 SET NODE=""
- +12 FOR
- SET NODE=$ORDER(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE,NODE))
- IF NODE=""
- QUIT
- Begin DoDot:4
- +13 SET ^TMP("ORWGRPC TEMP",$JOB,NODE)=""
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +14 SET NODE=""
- +15 FOR
- SET NODE=$ORDER(^TMP("ORWGRPC TEMP",$JOB,NODE))
- IF NODE=""
- QUIT
- Begin DoDot:1
- +16 DO PROB^ORWGAPIA(.PROB,.PSTATUS,.PROBDX,.DTONSET,.DTRESOLV,NODE)
- +17 IF 'DTONSET
- QUIT
- +18 IF 'DTRESOLV
- SET DTRESOLV=DTPLUS1
- +19 SET RESULT=9999911_U_PROBDX_U_DTONSET_U_DTRESOLV_U_$$EXT^ORWGAPIX(PSTATUS,9000011,.12)
- +20 DO SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
- End DoDot:1
- +21 KILL ^TMP("ORWGRPC TEMP",$JOB)
- +22 QUIT
- +23 ;