Routine: HBHCCAN

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

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

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHBHCCAN   1961     printed  Feb 18, 2025@23:24:22                                                                                                                                                                                                     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

HBHCCAN.m