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

IBATLM3A.m

Go to the documentation of this file. 
  1. IBATLM3A ;LL/ELZ - TRANSFER PRICING PT INFO SCREEN BUILD ; 16-APR-1999
  1.  ;;2.0;INTEGRATED BILLING;**115,516**;21-MAR-94;Build 123
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  N IBX,IBY,IBINPT,IBINS,IBCNT K ^TMP("IBATPT",$J)
  1.  ;
  1.  S IBCNT=0
  1.  S VAIP("D")="LAST" D A5^VADPT ; dbia 10061
  1.  S IBINPT=$G(^DPT(DFN,.105)) ; dbia 10035
  1.  S IBINS=$$INSURED^IBCNS1(DFN)
  1.  ;
  1.  S IBY=""
  1.  D SET("*** Demographic Information ***",.IBY,24,31)
  1.  D SETVALM(.VALMCNT,.IBY)
  1.  D CNTRL^VALM10(VALMCNT,24,31,IOINHI,IOINORM)
  1.  D SETVALM(.VALMCNT,"")
  1.  ;
  1.  D SET("Sex:",.IBY,21,4)
  1.  D SET($P(VADM(5),"^",2),.IBY,26,15)
  1.  D SET("Date of Birth:",.IBY,52,14)
  1.  D SET($P(VADM(3),"^",2),.IBY,67,13)
  1.  D SETVALM(.VALMCNT,.IBY)
  1.  ;
  1.  D SET("Primary Care Provider:",.IBY,3,22)
  1.  D SET($P($$OUTPTPR^SDUTL3(DFN),"^",2),.IBY,26,15) ; dbia 1252
  1.  D SET("Date of Death:",.IBY,52,14)
  1.  D SET($$DATE(+VADM(6)),.IBY,67,13)
  1.  D SETVALM(.VALMCNT,.IBY)
  1.  D SETVALM(.VALMCNT,"")
  1.  ;
  1.  D SET("Address:",.IBY,17,8)
  1.  F IBX=1:1:3 D:VAPA(IBX)'=""
  1.  . D SET(VAPA(IBX),.IBY,26,30)
  1.  . D SETVALM(.VALMCNT,.IBY)
  1.  D:IBY'="" SETVALM(.VALMCNT,.IBY)
  1.  ;
  1.  D SET(VAPA(4)_", "_$P(VAPA(5),"^",2)_"  "_VAPA(6),.IBY,26,30)
  1.  D SETVALM(.VALMCNT,.IBY)
  1.  D SETVALM(.VALMCNT,"")
  1.  D SETVALM(.VALMCNT,"")
  1.  ;
  1.  D SET("*** Eligibility Information ***",.IBY,24,31)
  1.  D SETVALM(.VALMCNT,.IBY)
  1.  D CNTRL^VALM10(VALMCNT,24,31,IOINHI,IOINORM)
  1.  D SETVALM(.VALMCNT,"")
  1.  ;
  1.  D SET("Patient Type:",.IBY,12,13)
  1.  D SET($P(VAEL(6),"^",2),.IBY,26,15)
  1.  D SET("Means Test Status:",.IBY,48,18)
  1.  D SET($P(VAEL(9),"^",2),.IBY,67,13)
  1.  D SETVALM(.VALMCNT,.IBY)
  1.  ;
  1.  D SET("Primary Eligibility:",.IBY,5,20)
  1.  D SET($P(VAEL(1),"^",2),.IBY,26,15)
  1.  D SET("Enrollment Priority:",.IBY,46,31)
  1.  D SET($$PRIORITY^DGENA(DFN),.IBY,67,3) ; dbia #2918
  1.  D SETVALM(.VALMCNT,.IBY)
  1.  D SETVALM(.VALMCNT,"")
  1.  ;
  1.  D SET("Secondary Eligibilities:",.IBY,1,24)
  1.  S IBX=0 F  S IBX=$O(VAEL(1,IBX)) Q:IBX<1  D
  1.  . D SET($P(VAEL(1,IBX),"^",2),.IBY,26,30)
  1.  . D SETVALM(.VALMCNT,.IBY)
  1.  D:IBY'="" SETVALM(.VALMCNT,.IBY)
  1.  D SETVALM(.VALMCNT,"")
  1.  ;
  1.  D SETVALM(.VALMCNT,"")
  1.  D SET("*** Insurance Information ***",.IBY,25,29)
  1.  D SETVALM(.VALMCNT,.IBY)
  1.  D CNTRL^VALM10(VALMCNT,25,29,IOINHI,IOINORM)
  1.  D SETVALM(.VALMCNT,"")
  1.  ;
  1.  I IBINS D ALL^IBCNS1(DFN,"^TMP(""IBINS"",$J)",1) D  K ^TMP("IBINS",$J)
  1.  . S IBX=0 F  S IBX=$O(^TMP("IBINS",$J,IBX))  Q:IBX<1  S IBX(0)=^(IBX,0) D
  1.  .. D SET($P(^DIC(36,+IBX(0),0),"^"),.IBY,5,30)
  1.  .. D SET($P(IBX(0),"^",2),.IBY,35,15)
  1.  .. ;IB*2.0*516/TAZ - Use HIPAA compliant fields
  1.  .. ; HIPAA compliant Group Number is returned in piece 3 of ^TMP("IBINS",$J,IBX,0).
  1.  .. ;I $P(IBX(0),"^",18),$D(^IBA(355.3,$P(IBX(0),"^",18),0)) D SET($P(^IBA(355.3,$P(IBX(0),"^",18),0),"^",3),.IBY,60,20)
  1.  .. D SET($P(IBX(0),U,3),.IBY,60,20)
  1.  .. ; end changes for 516
  1.  .. D SETVALM(.VALMCNT,.IBY)
  1.  E  D SET("Patient has no active insurance information",.IBY,5,75),SETVALM(.VALMCNT,.IBY)
  1.  D SETVALM(.VALMCNT,"")
  1.  ;
  1.  D SETVALM(.VALMCNT,"")
  1.  D SET("*** Inpatient Information ***",.IBY,26,29)
  1.  D SETVALM(.VALMCNT,.IBY)
  1.  D CNTRL^VALM10(VALMCNT,26,29,IOINHI,IOINORM)
  1.  D SETVALM(.VALMCNT,"")
  1.  ;
  1.  D SET("Inpatient Status:",.IBY,8,17)
  1.  D SET($S(IBINPT:"Active",1:"Inactive"),.IBY,26,10)
  1.  D SETVALM(.VALMCNT,.IBY)
  1.  ;
  1.  D SET("Last Admission:",.IBY,10,17)
  1.  D SET($S(VAIP(1)="":"Never Admitted",1:$P(VAIP(13,1),"^",2)),.IBY,26,17)
  1.  D SET("Ward Location:",.IBY,47,14)
  1.  D SET($P(VAIP(13,4),"^",2),.IBY,62,18)
  1.  D SETVALM(.VALMCNT,.IBY)
  1.  D SETVALM(.VALMCNT,"")
  1.  ;
  1.  D APPTS
  1.  ;
  1.  D KVAR^VADPT ; dbia 10061
  1.  ;
  1.  Q
  1. APPTS ; -- displays last 5 appointments
  1.  ;
  1.  D SETVALM(.VALMCNT,"")
  1.  D SET("*** Last Outpatient Appointments ***",.IBY,22,36)
  1.  D SETVALM(.VALMCNT,.IBY)
  1.  D CNTRL^VALM10(VALMCNT,22,36,IOINHI,IOINORM)
  1.  D SETVALM(.VALMCNT,"")
  1.  ;
  1.  N IBVAL,IBFILTER
  1.  S IBVAL("DFN")=DFN
  1.  S IBVAL("BDT")=0
  1.  S IBVAL("EDT")=$$NOW^XLFDT
  1.  ; screen children and inpatient encounters
  1.  S IBFILTER="I '$P(Y0,""^"",6),$P(Y0,""^"",12)'=8"
  1.  ;
  1.  D SCAN^IBSDU("PATIENT/DATE",.IBVAL,IBFILTER,"D APPTCB^IBATLM3A",0,,"BACKWARD")
  1.  ;
  1.  Q
  1. APPTCB ; call back for scan to set up global
  1.  ;
  1.  D SET($$DATE($P(Y0,"^"),5),.IBY,5,17)
  1.  D SET($P(^SC($P(Y0,"^",4),0),"^"),.IBY,25,30) ; dbia 10040
  1.  D SET($$EX^IBATUTL(409.68,.12,$P(Y0,"^",12)),.IBY,60,20)
  1.  D SETVALM(.VALMCNT,.IBY)
  1.  ;
  1.  S IBCNT=IBCNT+1
  1.  S:IBCNT>4 SDSTOP=1
  1.  Q
  1.  ;
  1. SET(TEXT,STRING,COL,LENGTH) ; -- set up string with valm1
  1.  S STRING=$$SETSTR^VALM1($$LOWER^VALM1(TEXT),STRING,COL,LENGTH)
  1.  Q
  1. SETVALM(LINE,TEXT) ; -- sets line for display
  1.  S LINE=LINE+1
  1.  S ^TMP("IBATPT",$J,LINE,0)=TEXT
  1.  S TEXT=""
  1.  Q
  1. DATE(X,Y) ; -- returns date for display
  1.  S:'$D(Y) Y="5D"
  1.  Q $S(X:$$FMTE^XLFDT(X,Y),1:"")