Routine: HBHCXMC

HBHCXMC ; LR VAMC(IRMS)/MJT-HBHC populate ^HBHC(634) with Form 6 Corrections, called by ^HBHCFILE, but can be run by D ^HBHCXMC ;9204

 ;;1.0;HOSPITAL BASED HOME CARE;**6**;NOV 01, 1993

LOOP ; Loop thru ^HBHC(634.4) (Correction records) to create nodes in ^HBHC(634) => transmit

 W !,"Processing Correction/Form 6 Data"

 S HBHCIEN=0 F  S HBHCIEN=$O(^HBHC(634.4,HBHCIEN)) Q:HBHCIEN'>0  S HBHCREC=^HBHC(634.4,HBHCIEN,0) D SETNODE

EXIT ; Exit module

 K DA,DIK,HBHCIEN,HBHCNDX1,HBHCREC

SETNODE ; Set node in ^HBHC(634) (Transmit)

 L +^HBHC(634,0) S HBHCNDX1=$P(^HBHC(634,0),U,3)+1,$P(^HBHC(634,0),U,3)=HBHCNDX1,$P(^HBHC(634,0),U,4)=$P(^HBHC(634,0),U,4)+1 L -^HBHC(634,0)

 S ^HBHC(634,HBHCNDX1,0)=HBHCREC,^HBHC(634,"B",$E(HBHCREC,1,30),HBHCNDX1)=""

 ; Kill entry in ^HBHC(634.4)

 K DIK S DIK="^HBHC(634.4,",DA=HBHCIEN D ^DIK

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHBHCXMC   839     printed  Feb 18, 2025@23:25:20                                                                                                                                                                                                      Page 2

HBHCXMC   ; LR VAMC(IRMS)/MJT-HBHC populate ^HBHC(634) with Form 6 Corrections, called by ^HBHCFILE, but can be run by D ^HBHCXMC ;9204

 +1       ;;1.0;HOSPITAL BASED HOME CARE;**6**;NOV 01, 1993

LOOP      ; Loop thru ^HBHC(634.4) (Correction records) to create nodes in ^HBHC(634) => transmit

 +1        WRITE !,"Processing Correction/Form 6 Data"

 +2        SET HBHCIEN=0

FOR

               SET HBHCIEN=$ORDER(^HBHC(634.4,HBHCIEN))

               if HBHCIEN'>0

                   QUIT

               SET HBHCREC=^HBHC(634.4,HBHCIEN,0)

               DO SETNODE

EXIT      ; Exit module

 +1        KILL DA,DIK,HBHCIEN,HBHCNDX1,HBHCREC

 +2        QUIT

SETNODE   ; Set node in ^HBHC(634) (Transmit)

 +1        LOCK +^HBHC(634,0)

           SET HBHCNDX1=$PIECE(^HBHC(634,0),U,3)+1

           SET $PIECE(^HBHC(634,0),U,3)=HBHCNDX1

           SET $PIECE(^HBHC(634,0),U,4)=$PIECE(^HBHC(634,0),U,4)+1

           LOCK -^HBHC(634,0)

 +2        SET ^HBHC(634,HBHCNDX1,0)=HBHCREC

           SET ^HBHC(634,"B",$EXTRACT(HBHCREC,1,30),HBHCNDX1)=""

 +3       ; Kill entry in ^HBHC(634.4)

 +4        KILL DIK

           SET DIK="^HBHC(634.4,"

           SET DA=HBHCIEN

           DO ^DIK

 +5        QUIT

HBHCXMC.m