HBHCCAN ; LR VAMC(IRMS)/MJT-HBHC batch job to flag deleted outpatient encounters as cancelled appointments in ^HBHC(632) (visit) Form 4 Transmit Status, field 7, & Cancelled Appointment, field 6, called from ^HBHCAPPT ;9803
;;1.0;HOSPITAL BASED HOME CARE;**6,10**;NOV 01, 1993
; Also deletes record from ^HBHC(634 (transmit) file IF Form 4 Transmit Status, field 7, = "F" (filed)
START ; Initialization
S $P(HBHCSP1," ",2)="",$P(HBHCZRO4,"0",5)=""
; HBHCBGDT set in ^HBHCAPPT
S HBHCAPDT=HBHCBGDT
LOOP ; Loop thru ^HBHC(632) to flag visit nodes with cancelled appointments
F S HBHCAPDT=$O(^HBHC(632,"C",HBHCAPDT)) Q:(HBHCAPDT'>0)!(HBHCAPDT>HBHCLSDT) S HBHCDFN=0 F S HBHCDFN=$O(^HBHC(632,"C",HBHCAPDT,HBHCDFN)) Q:HBHCDFN'>0 D PROCESS
EXIT ; Exit module
K DA,DIE,DIK,DR,HBHCAPDT,HBHCDATE,HBHCDFN,HBHCIEN,HBHCINFO,HBHCNOD0,HBHCPRV,HBHCREC,HBHCSP1,HBHCTIME,HBHCZRO4,X,Y,%DT
Q
PROCESS ; Process outpatient encounters in SCE(409.68
S HBHCNOD0=^HBHC(632,HBHCDFN,0)
; Cancelled appointment
Q:($P(HBHCNOD0,U,7)]"")!($P(HBHCNOD0,U,8)="C")
; Set Cancelled Appointment (fld 6) & Form 4 Transmit Status (fld 7) to C (cancelled appointment) if outpatient encounter (OE) no longer exists, retaining obsolete data elements (e.g. OE, Dx, provider, CPT) for trouble-shooting purposes
I $G(^SCE($P(HBHCNOD0,U,22),0))="" D:$P(HBHCNOD0,U,8)="F" DELETE S DIE="^HBHC(632,",DA=HBHCDFN,DR="6///C;7///C" D ^DIE
Q
DELETE ; Delete ^HBHC(634 file record
S HBHCTIME=$P(HBHCAPDT,".",2) S:$L(HBHCTIME)'=4 HBHCTIME=HBHCTIME_$E(HBHCZRO4,1,(4-($L(HBHCTIME))))
S HBHCDATE=$E(HBHCAPDT,4,5)_$E(HBHCAPDT,6,7)_(1700+$E(HBHCAPDT,1,3))_HBHCTIME
S HBHCPRV=+^HBHC(631.4,$P(HBHCNOD0,U,4),0) S:$L(HBHCPRV)'=4 HBHCPRV=HBHCPRV_HBHCSP1
S HBHCINFO=$P(^DPT($P(HBHCNOD0,U),0),U,9)_HBHCDATE_HBHCPRV
S HBHCIEN=0 F S HBHCIEN=$O(^HBHC(634,HBHCIEN)) Q:HBHCIEN'>0 S HBHCREC=$E(^HBHC(634,HBHCIEN,0),9,33) I HBHCINFO=HBHCREC K DIK S DIK="^HBHC(634,",DA=HBHCIEN D ^DIK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHBHCCAN 1961 printed Dec 13, 2024@01:57:59 Page 2
HBHCCAN ; LR VAMC(IRMS)/MJT-HBHC batch job to flag deleted outpatient encounters as cancelled appointments in ^HBHC(632) (visit) Form 4 Transmit Status, field 7, & Cancelled Appointment, field 6, called from ^HBHCAPPT ;9803
+1 ;;1.0;HOSPITAL BASED HOME CARE;**6,10**;NOV 01, 1993
+2 ; Also deletes record from ^HBHC(634 (transmit) file IF Form 4 Transmit Status, field 7, = "F" (filed)
START ; Initialization
+1 SET $PIECE(HBHCSP1," ",2)=""
SET $PIECE(HBHCZRO4,"0",5)=""
+2 ; HBHCBGDT set in ^HBHCAPPT
+3 SET HBHCAPDT=HBHCBGDT
LOOP ; Loop thru ^HBHC(632) to flag visit nodes with cancelled appointments
+1 FOR
SET HBHCAPDT=$ORDER(^HBHC(632,"C",HBHCAPDT))
if (HBHCAPDT'>0)!(HBHCAPDT>HBHCLSDT)
QUIT
SET HBHCDFN=0
FOR
SET HBHCDFN=$ORDER(^HBHC(632,"C",HBHCAPDT,HBHCDFN))
if HBHCDFN'>0
QUIT
DO PROCESS
EXIT ; Exit module
+1 KILL DA,DIE,DIK,DR,HBHCAPDT,HBHCDATE,HBHCDFN,HBHCIEN,HBHCINFO,HBHCNOD0,HBHCPRV,HBHCREC,HBHCSP1,HBHCTIME,HBHCZRO4,X,Y,%DT
+2 QUIT
PROCESS ; Process outpatient encounters in SCE(409.68
+1 SET HBHCNOD0=^HBHC(632,HBHCDFN,0)
+2 ; Cancelled appointment
+3 if ($PIECE(HBHCNOD0,U,7)]"")!($PIECE(HBHCNOD0,U,8)="C")
QUIT
+4 ; Set Cancelled Appointment (fld 6) & Form 4 Transmit Status (fld 7) to C (cancelled appointment) if outpatient encounter (OE) no longer exists, retaining obsolete data elements (e.g. OE, Dx, provider, CPT) for trouble-shooting purposes
+5 IF $GET(^SCE($PIECE(HBHCNOD0,U,22),0))=""
if $PIECE(HBHCNOD0,U,8)="F"
DO DELETE
SET DIE="^HBHC(632,"
SET DA=HBHCDFN
SET DR="6///C;7///C"
DO ^DIE
+6 QUIT
DELETE ; Delete ^HBHC(634 file record
+1 SET HBHCTIME=$PIECE(HBHCAPDT,".",2)
if $LENGTH(HBHCTIME)'=4
SET HBHCTIME=HBHCTIME_$EXTRACT(HBHCZRO4,1,(4-($LENGTH(HBHCTIME))))
+2 SET HBHCDATE=$EXTRACT(HBHCAPDT,4,5)_$EXTRACT(HBHCAPDT,6,7)_(1700+$EXTRACT(HBHCAPDT,1,3))_HBHCTIME
+3 SET HBHCPRV=+^HBHC(631.4,$PIECE(HBHCNOD0,U,4),0)
if $LENGTH(HBHCPRV)'=4
SET HBHCPRV=HBHCPRV_HBHCSP1
+4 SET HBHCINFO=$PIECE(^DPT($PIECE(HBHCNOD0,U),0),U,9)_HBHCDATE_HBHCPRV
+5 SET HBHCIEN=0
FOR
SET HBHCIEN=$ORDER(^HBHC(634,HBHCIEN))
if HBHCIEN'>0
QUIT
SET HBHCREC=$EXTRACT(^HBHC(634,HBHCIEN,0),9,33)
IF HBHCINFO=HBHCREC
KILL DIK
SET DIK="^HBHC(634,"
SET DA=HBHCIEN
DO ^DIK
+6 QUIT
