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

IB20P478.m

Go to the documentation of this file. 
  1. IB20P478 ;ALB/RDK - IB*2.0*478; TYPE OF VISIT UPDATE ; 6/13/12 10:44am
  1.  ;;2.0;INTEGRATED BILLING;**478**;21-MAR-94;Build 4
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1.  Q
  1. EN ;
  1.  N Y,IBC,IBT,IBX,CODE,HDR,TEXT,INACT,NEC,NCODE,NHDR,NTEXT,NINACT,NNEC,OCODE,OHDR,OTEXT,OINACT,ONEC,DA,DR,DIE
  1.  D START,GETCODE,FINISH
  1.  Q
  1.  ;
  1. START D BMES^XPDUTL("Type of Visit Codes, Post-Install Starting")
  1.  Q
  1.  ;
  1. FINISH D BMES^XPDUTL("Type of Visit Codes, Post-Install Complete")
  1.  Q
  1.  ;
  1.  ;
  1. GETCODE ; get codes to add to table
  1.  S IBC=0
  1.  D BMES^XPDUTL("   NOTE: If a Type of Visit Code already exists in file 357.69")
  1.  D BMES^XPDUTL("   values approved for national release will replace current values.")
  1.  D BMES^XPDUTL(" Adding or Updating type of visit codes to file 357.69")
  1.  F IBX=1:1 S IBT=$P($T(NCODE+IBX),";",3) Q:'$L(IBT)  D
  1.  . S CODE=+$P(IBT,U)
  1.  . S HDR=$P(IBT,U,2)
  1.  . S TEXT=$P(IBT,U,3)
  1.  . S INACT=$P(IBT,U,4)
  1.  . S NEC=$P(IBT,U,5)
  1.  . I $D(^IBE(357.69,CODE,0)) S Y=+$$UPD35769(CODE,HDR,TEXT,INACT,NEC) S:Y>0 IBC=IBC+1 Q
  1.  . S Y=+$$ADD35769(CODE,HDR,TEXT,INACT,NEC) S:Y>0 IBC=IBC+1
  1.  D BMES^XPDUTL("     "_IBC_$S(IBC=1:" entry",1:" entries")_" added or updated in file 357.69")
  1.  Q
  1.  ;
  1. ADD35769(NCODE,NHDR,NTEXT,NINACT,NNEC) ;
  1.  ;add a new entry into file <#357.69>
  1.  N X,DLAYGO,DINUM,DIC
  1.  S DLAYGO="357.69",(X,DINUM)=NCODE,DIC="^IBE(357.69,",DIC(0)="KLM"
  1.  S DIC("DR")=".02///^S X=NHDR;.03///^S X=NTEXT;.04///^S X=NINACT;.05///^S X=NNEC"
  1.  D ^DIC
  1.  I (+Y=-1) D BMES^XPDUTL("*** ERROR ON CODE "_NCODE_" ***") Q (+Y)
  1.  I (+Y=NCODE) D BMES^XPDUTL("   Adding  "_NCODE_"  "_NTEXT)
  1.  Q (+Y)
  1.  ;
  1. UPD35769(OCODE,OHDR,OTEXT,OINACT,ONEC) ;
  1.  ;update an existing entry in file <#357.69>
  1.  S:OINACT="" OINACT="@" ; If inactive flag is supposed to be null make sure that field is nulled out in the existing record.
  1.  S DIE="^IBE(357.69,",DA=OCODE,DR=".02///^S X=OHDR;.03///^S X=OTEXT;.04///^S X=OINACT;.05///^S X=ONEC"
  1.  D ^DIE
  1.  S Y=0 I $P(^IBE(357.69,OCODE,0),U,3)=OTEXT S Y=1 D BMES^XPDUTL("   Update  "_OCODE_"  "_OTEXT)
  1.  Q (+Y)
  1.  ;type of visit codes to load into file (#357.69)
  1. NCODE ;;code^header^text^inactive flag^new/established/consult flag (nec)
  1.  ;;99234^DET OBSERV/HOSP SAME DATE^Detailed Observ or Inpt hospital care^^9
  1.  ;;99235^COMP OBSERV/HOSP SAME DATE^Comp Observ or Inpt hospital care^^9
  1.  ;;99236^HI COMP OBSERV/HOSP SAME DATE^Hi Comp Observ or Inpt hospital care^^9
  1.  ;;99239^Hospital D/C Svc->30 MIN^Hospital D/C Day Mgmt->30 min^^2
  1.  ;;99304^Init Nurs Fac Care-Detailed^Initial Nursing Facility Care-Detailed^^1
  1.  ;;99305^Init Nurs Fac Care-Comp^Initial Nursing Facility Care-Comp^^1
  1.  ;;99306^Init Nurs Fac Care-Hi Comp^Initial Nursing Facility Care-Hi Comp^^1
  1.  ;;99307^SUBSEQ Nurs Fac Care-Prob Foc^Subseq Nursing Facility Care-Prob Focus^^2
  1.  ;;99308^SUBSEQ NURS FAC CARE-EXP PF^Subseq Nurs Facility Care-Ex Prob Focus^^2
  1.  ;;99309^SUBSEQ NURS FAC CARE-DET^Subseq Nursing Facility Care-Detailed ^^2
  1.  ;;99310^SUBSEQ Nurs Fac Care-COMP^Subseq Nursing Facility Care-Comp^^2
  1.  ;;99315^NURS FAC D/C Svc-30 MIN^Nursing Facility D/C Day Mgmt-30 min^^9
  1.  ;;99316^NURS FAC D/C Svc->30 MIN^Nursing Facility D/C Day Mgmt->30 min^^9
  1.  ;;99318^Nurs Fac Svc-ANNUAL ASSESS^Nursing Facility Care-Annual Assessment^^2
  1.  ;;99377^Care Plan Oversight-HOSPICE^Care Plan Oversight-Hospice^^2
  1.  ;;99378^Care Plan Oversight-NURS FAC^Care Plan Oversight-Nursing Facility^^2
  1.  ;