VIABPCE2 ;AITC/BWF - wrap calls to PCE ;2/12/16 15:13
;;1.0;VISTA INTEGRATION ADAPTER;**5,12**;06-FEB-2014;Build 28
; ICR 6904 HEALTH FACTORS file #9999999.64 (private)
Q
HFTYPE(VIALST,ADDCATS) ;get the list of active health factors
N IEN,CNT,BINDEX,REC
S (CNT,BINDEX)=0,ADDCATS=+$G(ADDCATS)
F S BINDEX=$O(^AUTTHF("B",BINDEX)) Q:BINDEX']"" D
.S IEN=0 F S IEN=$O(^AUTTHF("B",BINDEX,IEN)) Q:'+IEN D
..S REC=$G(^AUTTHF(IEN,0))
..I +$P(REC,U,11) S REC=""
..I 'ADDCATS,$P(REC,U,10)="C" S REC=""
..I REC'="" D
...S CNT=CNT+1,VIALST(CNT)=IEN_U_$P(REC,U)
...I ADDCATS S VIALST(CNT)=VIALST(CNT)_U_$P(REC,U,10)_U_$P(REC,U,3)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVIABPCE2 656 printed Dec 13, 2024@02:45:19 Page 2
VIABPCE2 ;AITC/BWF - wrap calls to PCE ;2/12/16 15:13
+1 ;;1.0;VISTA INTEGRATION ADAPTER;**5,12**;06-FEB-2014;Build 28
+2 ; ICR 6904 HEALTH FACTORS file #9999999.64 (private)
+3 QUIT
HFTYPE(VIALST,ADDCATS) ;get the list of active health factors
+1 NEW IEN,CNT,BINDEX,REC
+2 SET (CNT,BINDEX)=0
SET ADDCATS=+$GET(ADDCATS)
+3 FOR
SET BINDEX=$ORDER(^AUTTHF("B",BINDEX))
if BINDEX']""
QUIT
Begin DoDot:1
+4 SET IEN=0
FOR
SET IEN=$ORDER(^AUTTHF("B",BINDEX,IEN))
if '+IEN
QUIT
Begin DoDot:2
+5 SET REC=$GET(^AUTTHF(IEN,0))
+6 IF +$PIECE(REC,U,11)
SET REC=""
+7 IF 'ADDCATS
IF $PIECE(REC,U,10)="C"
SET REC=""
+8 IF REC'=""
Begin DoDot:3
+9 SET CNT=CNT+1
SET VIALST(CNT)=IEN_U_$PIECE(REC,U)
+10 IF ADDCATS
SET VIALST(CNT)=VIALST(CNT)_U_$PIECE(REC,U,10)_U_$PIECE(REC,U,3)
End DoDot:3
End DoDot:2
End DoDot:1
+11 QUIT
