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

DVBAB82D.m

Go to the documentation of this file.
  1. DVBAB82D ;BHAMOI/JFW - CAPRI CNH DELIMITED REPORTS ; 9/24/10 1:59pm
  1. ;;2.7;AMIE;**149,185**;Apr 10, 1995;Build 18
  1. ;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ;Input : DVBARPTID - Identifies report to delimit
  1. ; ^TMP("DVBA",$J,1) contains report in standard output
  1. ;Output: ^TMP("DVBADLMTD",$J) contains delimited report
  1. ;
  1. DLMTRPT(DVBARPTID) ;delimit CNH report
  1. N DVBADLMTR,DVBADRPT
  1. S DVBADLMTR=",",DVBADRPT=$NA(^TMP("DVBADLMTD",$J))
  1. K @DVBADRPT
  1. ;create specific delimited report
  1. D @(DVBARPTID_"(DVBADLMTR,DVBADRPT)")
  1. K ^TMP("DVBA",$J)
  1. Q
  1. ;
  1. 11(DVBADLMTR,DVBADRPT) ;Nursing Home Roster Report Output
  1. N DVBAI,DVBAX,DVBAQUIT,DVBASTR,DVBACNTR,DVBATMP,DVBAVEN,DVBAVENID
  1. ;check to see if any results found
  1. I ('$D(^TMP("DVBA",$J,1,9))) D Q
  1. .S @DVBADRPT@(1)="No data found."_$C(13)
  1. D COLHDR52(DVBADLMTR,DVBADRPT) ;delimited column header info
  1. S DVBACNTR=$O(@DVBADRPT@("A"),-1)+1
  1. S DVBAI=8 F S DVBAI=$O(^TMP("DVBA",$J,1,DVBAI)) Q:'+DVBAI D
  1. .S DVBASTR=$G(^TMP("DVBA",$J,1,DVBAI))
  1. .;ignore blank lines (Seperates Entries) OR report headers
  1. .Q:((DVBASTR="")!($E(DVBASTR,1,11)="VENDOR NAME")!($E(DVBASTR,1)=" ")!(DVBASTR[$C(10)))
  1. .S DVBAVEN=$$TRUNC($E(DVBASTR,1,49)),DVBAVENID=$$TRUNC($E(DVBASTR,51,80))
  1. .S DVBAQUIT=0,DVBAX=DVBAI
  1. .;quit inner loop when no more veterans for specific vendor
  1. .;or end of global array reached
  1. .F S DVBAX=$O(^TMP("DVBA",$J,1,DVBAX)) Q:((DVBAQUIT)!('+DVBAX)) D
  1. ..S DVBASTR=$G(^TMP("DVBA",$J,1,DVBAX)),DVBATMP=""
  1. ..I ($E(DVBASTR,1)'=" ") S DVBAQUIT=1,DVBAI=DVBAX Q
  1. ..;Vendor Name^Vendor ID
  1. ..S DVBATMP=DVBAVEN_DVBADLMTR_DVBAVENID_DVBADLMTR
  1. ..;Veteran Name^Veteran ID^Admit DT^Auth. To Date
  1. ..S DVBATMP=DVBATMP_""""_$$TRUNC($E(DVBASTR,5,36))_""""_DVBADLMTR_$$TRUNC($E(DVBASTR,38,52))_DVBADLMTR
  1. ..S DVBATMP=DVBATMP_$$TRIM($$TRUNC($E(DVBASTR,54,64)))_DVBADLMTR_$$TRIM($$TRUNC($E(DVBASTR,66,80)))
  1. ..;Save off CNH info and increment counters
  1. ..S @DVBADRPT@(DVBACNTR)=DVBATMP_$C(13),DVBACNTR=DVBACNTR+1
  1. Q
  1. ;
  1. 12(DVBADLMTR,DVBADRPT) ;CNH Admission/Discharge Report Output
  1. N DVBAI,DVBASTR,DVBACNTR,DVBATMP
  1. ;check to see if any results found
  1. I ('$D(^TMP("DVBA",$J,1,7))) D Q
  1. .S @DVBADRPT@(1)="No data found for parameters entered."_$C(13)
  1. D COLHDR53(DVBADLMTR,DVBADRPT) ;delimited column header info
  1. S DVBACNTR=$O(@DVBADRPT@("A"),-1)+1
  1. S DVBAI=6 F S DVBAI=$O(^TMP("DVBA",$J,1,DVBAI)) Q:'+DVBAI D
  1. .S DVBASTR=$G(^TMP("DVBA",$J,1,DVBAI))
  1. .;ignore blank lines (Seperates Entries) OR report headers
  1. .Q:((DVBASTR="")!($E(DVBASTR,1)=" ")!(DVBASTR[$C(10)))
  1. .S DVBATMP=""
  1. .;Patient Name^Patient ID^Eligibility
  1. .;S DVBATMP=$$TRUNC($E(DVBASTR,1,31))_DVBADLMTR_$$TRUNC($E(DVBASTR,33,47))_DVBADLMTR_$$TRUNC($E(DVBASTR,49,80))_DVBADLMTR
  1. .S DVBATMP=""""_$$TRUNC($E(DVBASTR,1,31))_""""_DVBADLMTR_$$TRUNC($E(DVBASTR,33,47))_DVBADLMTR_$$TRUNC($E(DVBASTR,49,80))_DVBADLMTR
  1. .S DVBAI=DVBAI+1,DVBASTR=$G(^TMP("DVBA",$J,1,DVBAI))
  1. .;Activity Type^Date^Date/Time^Sub Type
  1. .S DVBATMP=DVBATMP_$P($$TRIM(DVBASTR)," ")_DVBADLMTR_$$TRUNC($E(DVBASTR,20,35))_DVBADLMTR_$$TRUNC($E(DVBASTR,53,80))_DVBADLMTR
  1. .S DVBAI=DVBAI+1,DVBASTR=$G(^TMP("DVBA",$J,1,DVBAI))
  1. .;Nursing Home Information (ID^Name^Address^Phone) is optional
  1. .D:(DVBASTR="")
  1. ..S DVBATMP=DVBATMP_DVBADLMTR_DVBADLMTR_DVBADLMTR
  1. .D:(DVBASTR'="")
  1. ..S DVBATMP=DVBATMP_$$TRUNC($E(DVBASTR,43,80))_DVBADLMTR_$$TRUNC($E(DVBASTR,11,41))_DVBADLMTR
  1. ..S DVBASTR=$$TRIM($$TRUNC($G(^TMP("DVBA",$J,1,DVBAI+1))))
  1. ..S:(DVBASTR]"") DVBATMP=DVBATMP_DVBASTR_" " ;Address 1
  1. ..S DVBATMP=DVBATMP_$$TRIM($$TRUNC($G(^TMP("DVBA",$J,1,DVBAI+2))))_DVBADLMTR ;Address 2
  1. ..S DVBATMP=DVBATMP_$$TRIM($$TRUNC($P($G(^TMP("DVBA",$J,1,DVBAI+3)),":",2))) ;Phone
  1. ..S DVBAI=DVBAI+3
  1. .;Save off CNH info and increment counters
  1. .S @DVBADRPT@(DVBACNTR)=DVBATMP_$C(13),DVBACNTR=DVBACNTR+1
  1. Q
  1. ;
  1. ;Input : DVBADLMTR - Delimiter to use between components
  1. ; DVBADRPT - Delimited Report container (Full Global Ref)
  1. ;Output: Delimited report info added to DVBADRPT
  1. 13(DVBADLMTR,DVBADRPT) ; CNH stays > 90 days Report Output
  1. N DVBAI,DVBASTR,DVBACNTR,DVBATMP
  1. ;check to see if any results found
  1. I ($G(^TMP("DVBA",$J,1,9))="") D Q
  1. .S @DVBADRPT@(1)="No data found for parameter entered."_$C(13)
  1. D COLHDR50(DVBADLMTR,DVBADRPT) ;delimited column header info
  1. S DVBACNTR=$O(@DVBADRPT@("A"),-1)+1
  1. S DVBAI=8 F S DVBAI=$O(^TMP("DVBA",$J,1,DVBAI)) Q:'+DVBAI D
  1. .S DVBASTR=$G(^TMP("DVBA",$J,1,DVBAI))
  1. .Q:(DVBASTR["***LOS =") ;end of report info
  1. .;ignore blank lines OR report headers
  1. .Q:((DVBASTR="")!($E(DVBASTR,1,7)="VETERAN")!($E(DVBASTR,1)=" ")!(DVBASTR[$C(10)))
  1. .S DVBATMP=""
  1. .;Veteran^Pt.ID^Marital St.^Adm. Date^LOS^Vendor
  1. .S DVBATMP=""""_$$TRUNC($E(DVBASTR,1,17))_""""_DVBADLMTR_$$TRUNC($E(DVBASTR,19,31))_DVBADLMTR
  1. .S DVBATMP=DVBATMP_$$TRUNC($E(DVBASTR,33,34))_DVBADLMTR_$$TRUNC($E(DVBASTR,36,44))_DVBADLMTR
  1. .S DVBATMP=DVBATMP_$$TRIM($$TRUNC($E(DVBASTR,46,52)))_DVBADLMTR_$$TRUNC($E(DVBASTR,54,80))
  1. .;Save off CNH info and increment counters
  1. .S @DVBADRPT@(DVBACNTR)=DVBATMP_$C(13),DVBACNTR=DVBACNTR+1
  1. Q
  1. ;
  1. ;Delimited Column header for CNH stays in excess of 90 days Report
  1. COLHDR50(DVBADLMTR,DVBADRPT) ;
  1. N DVBAHDR
  1. S DVBAHDR="Veteran"_DVBADLMTR_"Pt. ID"_DVBADLMTR_"Marital St."_DVBADLMTR
  1. S DVBAHDR=DVBAHDR_"Adm. Date"_DVBADLMTR_"LOS"_DVBADLMTR_"Vendor"
  1. S @DVBADRPT@($O(@DVBADRPT@("A"),-1)+1)=DVBAHDR_$C(13)
  1. Q
  1. ;
  1. ;Delimited Column header for Nursing Home Roster Report
  1. COLHDR52(DVBADLMTR,DVBADRPT) ;
  1. N DVBAHDR
  1. S DVBAHDR="Vendor Name"_DVBADLMTR_"Vendor ID"_DVBADLMTR_"Veteran Name"_DVBADLMTR
  1. S DVBAHDR=DVBAHDR_"Veteran ID"_DVBADLMTR_"Admit DT"_DVBADLMTR_"Auth. To Date"
  1. S @DVBADRPT@($O(@DVBADRPT@("A"),-1)+1)=DVBAHDR_$C(13)
  1. Q
  1. ;
  1. ;Delimited Column header for Admission/Discharge Report
  1. COLHDR53(DVBADLMTR,DVBADRPT) ;
  1. N DVBAHDR
  1. S DVBAHDR="Patient Name"_DVBADLMTR_"Patient ID"_DVBADLMTR_"Eligibility"_DVBADLMTR
  1. S DVBAHDR=DVBAHDR_"Activity Type"_DVBADLMTR_"Actvity Date/Time"_DVBADLMTR
  1. S DVBAHDR=DVBAHDR_"Activity Sub Type"_DVBADLMTR_"CNH ID"_DVBADLMTR
  1. S DVBAHDR=DVBAHDR_"CNH Name"_DVBADLMTR_"CNH Address"_DVBADLMTR_"CNH Phone #"
  1. S @DVBADRPT@($O(@DVBADRPT@("A"),-1)+1)=DVBAHDR_$C(13)
  1. Q
  1. ;
  1. ;Input : DVBASTR - string to check for trailing spaces
  1. ;Output: String with trailing spaces, Line/Form feeds removed
  1. TRUNC(DVBASTR) ;remove trailing spaces and line/form feeds in string
  1. N DVBAX
  1. Q:(DVBASTR="") ""
  1. F DVBAX=$L(DVBASTR):-1:0 Q:(($E(DVBASTR,DVBAX,DVBAX)'=" ")&(($E(DVBASTR,DVBAX,DVBAX))'[$C(13))&($E(DVBASTR,DVBAX,DVBAX)'[$C(12)))
  1. Q ($E(DVBASTR,1,DVBAX))
  1. ;
  1. ;Input : DVBASTR - string to check for leading spaces
  1. ;Output: String with leading spaces removed
  1. TRIM(DVBASTR) ;remove leading spaces in string
  1. N DVBAX
  1. Q:(DVBASTR="") ""
  1. F DVBAX=1:1:$L(DVBASTR) Q:($E(DVBASTR,DVBAX,DVBAX)?1AN)
  1. Q ($E(DVBASTR,DVBAX,$L(DVBASTR)))