- ORWGAPI5 ; SLC/STAFF - Graph Items, Meds ;12/21/05 08:15
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242
- ;
- BCMA(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
- N DATE,DRUG,ITEM,NUM,RESULT
- K ^TMP("ORWGRPC TEMP",$J)
- I FMT=6 D
- . S DATE=OLDEST
- . F S DATE=$O(^PSB(53.79,"AADT",DFN,DATE)) Q:DATE<1 Q:DATE>NEWEST D
- .. S NUM=0
- .. F S NUM=$O(^PSB(53.79,"AADT",DFN,DATE,NUM)) Q:NUM<1 D
- ... S ITEM=$P($G(^PSB(53.79,NUM,0)),U,8) I 'ITEM Q
- ... I $D(^TMP("ORWGRPC TEMP",$J,ITEM)) Q
- ... S ^TMP("ORWGRPC TEMP",$J,ITEM)=""
- ... S CNT=CNT+1
- ... S RESULT="53.79^"_ITEM
- ... D SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
- I FMT'=6 D
- . S ITEM=""
- . F S ITEM=$O(^PSB(53.79,"AOIP",DFN,ITEM)) Q:ITEM="" D
- .. S DATE=$O(^PSB(53.79,"AOIP",DFN,ITEM,""),-1)
- .. I 'DATE Q
- .. S NUM=$O(^PSB(53.79,"AOIP",DFN,ITEM,DATE,""),-1)
- .. I 'NUM Q
- .. S CNT=CNT+1
- .. I FMT=3 S RESULT="53.79^"_ITEM_"^^"_$$POINAME^ORWGAPIC(ITEM)_"^^"_DATE
- .. I FMT=0 S RESULT="53.79^"_ITEM_U_$$POINAME^ORWGAPIC(ITEM)
- .. S DRUG=$$DRUG^ORWGAPIC(NUM)
- .. I DRUG S RESULT=RESULT_U_$$DRGCLASS^ORWGAPIC(DRUG)
- .. D SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
- K ^TMP("ORWGRPC TEMP",$J)
- Q
- ;
- DC(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
- ; FMT,OLDEST,NEWEST not used
- N DATA,DATE,DATE1,DRUG,ITEM,FILE,NUM,REF,RESULT K DATA
- K ^TMP("ORWGRPC DC",$J)
- F FILE=52,55 D
- . S ITEM=""
- . F S ITEM=$O(^PXRMINDX(FILE,"PI",DFN,ITEM)) Q:ITEM="" D
- .. S RESULT=$$DRGCLASS^ORWGAPIC(ITEM)
- .. I RESULT="" Q
- .. S RESULT="50.605^"_RESULT
- .. S ^TMP("ORWGRPC DC",$J,RESULT)=""
- S ITEM=""
- F S ITEM=$O(^PSB(53.79,"AOIP",DFN,ITEM)) Q:ITEM="" D
- . S DATE=$O(^PSB(53.79,"AOIP",DFN,ITEM,""),-1)
- . I 'DATE Q
- . S NUM=$O(^PSB(53.79,"AOIP",DFN,ITEM,DATE,""),-1)
- . I 'NUM Q
- . S DRUG=$$DRUG^ORWGAPIC(NUM)
- . I 'DRUG Q
- . S RESULT=$$DRGCLASS^ORWGAPIC(DRUG)
- . I 'RESULT Q
- . S RESULT="50.605^"_RESULT
- . S ^TMP("ORWGRPC DC",$J,RESULT)=""
- S ITEM=""
- F S ITEM=$O(^PXRMINDX("55NVA","PI",DFN,ITEM)) Q:ITEM="" D
- . S DATE=$O(^PXRMINDX("55NVA","PI",DFN,ITEM,""),-1)
- . I 'DATE Q
- . S DATE1=$O(^PXRMINDX("55NVA","PI",DFN,ITEM,DATE,""),-1)
- . I '$L(DATE1) Q
- . S REF=$O(^PXRMINDX("55NVA","PI",DFN,ITEM,DATE,DATE1,""),-1)
- . I '$L(REF) Q
- . D RXNVA^ORWGAPIC(REF,.DATA)
- . S DRUG=+$G(DATA("DISPENSE DRUG"))
- . I 'DRUG Q
- . S RESULT=$$DRGCLASS^ORWGAPIC(DRUG)
- . I 'RESULT Q
- . S RESULT="50.605^"_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
- ;
- NVA(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
- D NVA1^ORWGAPIE(.ITEMS,DFN,FMT,OLDEST,NEWEST,.CNT,.TMP)
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWGAPI5 2761 printed Feb 19, 2025@00:02:47 Page 2
- ORWGAPI5 ; SLC/STAFF - Graph Items, Meds ;12/21/05 08:15
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242
- +2 ;
- BCMA(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
- +1 NEW DATE,DRUG,ITEM,NUM,RESULT
- +2 KILL ^TMP("ORWGRPC TEMP",$JOB)
- +3 IF FMT=6
- Begin DoDot:1
- +4 SET DATE=OLDEST
- +5 FOR
- SET DATE=$ORDER(^PSB(53.79,"AADT",DFN,DATE))
- if DATE<1
- QUIT
- if DATE>NEWEST
- QUIT
- Begin DoDot:2
- +6 SET NUM=0
- +7 FOR
- SET NUM=$ORDER(^PSB(53.79,"AADT",DFN,DATE,NUM))
- if NUM<1
- QUIT
- Begin DoDot:3
- +8 SET ITEM=$PIECE($GET(^PSB(53.79,NUM,0)),U,8)
- IF 'ITEM
- QUIT
- +9 IF $DATA(^TMP("ORWGRPC TEMP",$JOB,ITEM))
- QUIT
- +10 SET ^TMP("ORWGRPC TEMP",$JOB,ITEM)=""
- +11 SET CNT=CNT+1
- +12 SET RESULT="53.79^"_ITEM
- +13 DO SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +14 IF FMT'=6
- Begin DoDot:1
- +15 SET ITEM=""
- +16 FOR
- SET ITEM=$ORDER(^PSB(53.79,"AOIP",DFN,ITEM))
- if ITEM=""
- QUIT
- Begin DoDot:2
- +17 SET DATE=$ORDER(^PSB(53.79,"AOIP",DFN,ITEM,""),-1)
- +18 IF 'DATE
- QUIT
- +19 SET NUM=$ORDER(^PSB(53.79,"AOIP",DFN,ITEM,DATE,""),-1)
- +20 IF 'NUM
- QUIT
- +21 SET CNT=CNT+1
- +22 IF FMT=3
- SET RESULT="53.79^"_ITEM_"^^"_$$POINAME^ORWGAPIC(ITEM)_"^^"_DATE
- +23 IF FMT=0
- SET RESULT="53.79^"_ITEM_U_$$POINAME^ORWGAPIC(ITEM)
- +24 SET DRUG=$$DRUG^ORWGAPIC(NUM)
- +25 IF DRUG
- SET RESULT=RESULT_U_$$DRGCLASS^ORWGAPIC(DRUG)
- +26 DO SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
- End DoDot:2
- End DoDot:1
- +27 KILL ^TMP("ORWGRPC TEMP",$JOB)
- +28 QUIT
- +29 ;
- DC(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
- +1 ; FMT,OLDEST,NEWEST not used
- +2 NEW DATA,DATE,DATE1,DRUG,ITEM,FILE,NUM,REF,RESULT
- KILL DATA
- +3 KILL ^TMP("ORWGRPC DC",$JOB)
- +4 FOR FILE=52,55
- Begin DoDot:1
- +5 SET ITEM=""
- +6 FOR
- SET ITEM=$ORDER(^PXRMINDX(FILE,"PI",DFN,ITEM))
- if ITEM=""
- QUIT
- Begin DoDot:2
- +7 SET RESULT=$$DRGCLASS^ORWGAPIC(ITEM)
- +8 IF RESULT=""
- QUIT
- +9 SET RESULT="50.605^"_RESULT
- +10 SET ^TMP("ORWGRPC DC",$JOB,RESULT)=""
- End DoDot:2
- End DoDot:1
- +11 SET ITEM=""
- +12 FOR
- SET ITEM=$ORDER(^PSB(53.79,"AOIP",DFN,ITEM))
- if ITEM=""
- QUIT
- Begin DoDot:1
- +13 SET DATE=$ORDER(^PSB(53.79,"AOIP",DFN,ITEM,""),-1)
- +14 IF 'DATE
- QUIT
- +15 SET NUM=$ORDER(^PSB(53.79,"AOIP",DFN,ITEM,DATE,""),-1)
- +16 IF 'NUM
- QUIT
- +17 SET DRUG=$$DRUG^ORWGAPIC(NUM)
- +18 IF 'DRUG
- QUIT
- +19 SET RESULT=$$DRGCLASS^ORWGAPIC(DRUG)
- +20 IF 'RESULT
- QUIT
- +21 SET RESULT="50.605^"_RESULT
- +22 SET ^TMP("ORWGRPC DC",$JOB,RESULT)=""
- End DoDot:1
- +23 SET ITEM=""
- +24 FOR
- SET ITEM=$ORDER(^PXRMINDX("55NVA","PI",DFN,ITEM))
- if ITEM=""
- QUIT
- Begin DoDot:1
- +25 SET DATE=$ORDER(^PXRMINDX("55NVA","PI",DFN,ITEM,""),-1)
- +26 IF 'DATE
- QUIT
- +27 SET DATE1=$ORDER(^PXRMINDX("55NVA","PI",DFN,ITEM,DATE,""),-1)
- +28 IF '$LENGTH(DATE1)
- QUIT
- +29 SET REF=$ORDER(^PXRMINDX("55NVA","PI",DFN,ITEM,DATE,DATE1,""),-1)
- +30 IF '$LENGTH(REF)
- QUIT
- +31 DO RXNVA^ORWGAPIC(REF,.DATA)
- +32 SET DRUG=+$GET(DATA("DISPENSE DRUG"))
- +33 IF 'DRUG
- QUIT
- +34 SET RESULT=$$DRGCLASS^ORWGAPIC(DRUG)
- +35 IF 'RESULT
- QUIT
- +36 SET RESULT="50.605^"_RESULT
- +37 SET ^TMP("ORWGRPC DC",$JOB,RESULT)=""
- End DoDot:1
- +38 SET RESULT=""
- +39 FOR
- SET RESULT=$ORDER(^TMP("ORWGRPC DC",$JOB,RESULT))
- if RESULT=""
- QUIT
- SET CNT=CNT+1
- Begin DoDot:1
- +40 DO SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
- End DoDot:1
- +41 KILL ^TMP("ORWGRPC DC",$JOB)
- +42 QUIT
- +43 ;
- NVA(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
- +1 DO NVA1^ORWGAPIE(.ITEMS,DFN,FMT,OLDEST,NEWEST,.CNT,.TMP)
- +2 QUIT
- +3 ;