- 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 Jan 18, 2025@03:37:20 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 ;