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