HBHCPS15 ; LR VAMC(IRMS)/MJT-HBHC Patch 15 Post-installation conversion routine, Unlimited CPT Codes, Convert 10 CPT Code fields in node 1, to multiple, then kill node 1 ; 9907
;;1.0;HOSPITAL BASED HOME CARE;**15**;NOV 01, 1993
; Loop thru HBHC(632, move CPT codes from node 1 to multiple, then kill node 1
S HBHCIEN=0 F S HBHCIEN=$O(^HBHC(632,HBHCIEN)) Q:HBHCIEN'>0 S HBHCINFO=$G(^HBHC(632,HBHCIEN,1)) I HBHCINFO]"" F HBHCI=1:1:10 Q:$P(HBHCINFO,U,HBHCI)="" D SET K ^HBHC(632,HBHCIEN,1)
S DIK="^DD(632,",DA(1)=632 F DA=21:1:30 D ^DIK
EXIT ; Exit module
K DA,DD,DIC,DO,HBHCI,HBHCIEN,HBHCINFO,X
Q
SET ; Set CPT multiple
K DD,DO
S DA(1)=HBHCIEN,DIC="^HBHC(632,DA(1),2,",DIC(0)="L",DIC("P")=$P(^DD(632,32,0),U,2),X=$P(HBHCINFO,U,HBHCI) D FILE^DICN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHBHCPS15 770 printed Sep 23, 2025@19:34:13 Page 2
HBHCPS15 ; LR VAMC(IRMS)/MJT-HBHC Patch 15 Post-installation conversion routine, Unlimited CPT Codes, Convert 10 CPT Code fields in node 1, to multiple, then kill node 1 ; 9907
+1 ;;1.0;HOSPITAL BASED HOME CARE;**15**;NOV 01, 1993
+2 ; Loop thru HBHC(632, move CPT codes from node 1 to multiple, then kill node 1
+3 SET HBHCIEN=0
FOR
SET HBHCIEN=$ORDER(^HBHC(632,HBHCIEN))
if HBHCIEN'>0
QUIT
SET HBHCINFO=$GET(^HBHC(632,HBHCIEN,1))
IF HBHCINFO]""
FOR HBHCI=1:1:10
if $PIECE(HBHCINFO,U,HBHCI)=""
QUIT
DO SET
KILL ^HBHC(632,HBHCIEN,1)
+4 SET DIK="^DD(632,"
SET DA(1)=632
FOR DA=21:1:30
DO ^DIK
EXIT ; Exit module
+1 KILL DA,DD,DIC,DO,HBHCI,HBHCIEN,HBHCINFO,X
+2 QUIT
SET ; Set CPT multiple
+1 KILL DD,DO
+2 SET DA(1)=HBHCIEN
SET DIC="^HBHC(632,DA(1),2,"
SET DIC(0)="L"
SET DIC("P")=$PIECE(^DD(632,32,0),U,2)
SET X=$PIECE(HBHCINFO,U,HBHCI)
DO FILE^DICN
+3 QUIT
