FBAAPI ;AISC/GRR-PATIENT INQUIRY ;03JAN86
;;3.5;FEE BASIS;;JAN 30, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
RD K FBAANQ W !! S DIC="^DPT(",DIC(0)="AEQM" D ^DIC G Q:X="^"!(X=""),RD:Y<0 S DFN=+Y
S VAR="DFN",VAL=DFN,PGM="START^FBAAPI" D ZIS^FBAAUTL G:FBPOP Q S:IO=IO(0) FBAANQ=1
START U IO
W ! D ^FBAADEM
I $E(IOST,1,2)="C-" D
. Q:'$O(^FBAA(161.5,"D",DFN,0))
.W !!,"Patient also has Inpatient Report(s) of Contact with the following date(s):",!
. S I=0 F S I=$O(^FBAA(161.5,"D",DFN,I)) Q:'I S Y=$P($G(^FBAA(162.2,I,0)),"^") D DD^%DT W !?10,Y
G:$D(FBAANQ) RD
Q K DIC,X,Y,FBAAOUT,FBAUT,FBPROG,PTYPE,X1,FBAANQ,DFN,DAT,F,FBCOUNTY,FBDX,FBI,FBRR,FBXX,I,PGM,PI,T,VAL,VAR,Z,ZZ,M,Q
D CLOSE^FBAAUTL Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAAPI 746 printed Nov 22, 2024@17:06:14 Page 2
FBAAPI ;AISC/GRR-PATIENT INQUIRY ;03JAN86
+1 ;;3.5;FEE BASIS;;JAN 30, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
RD KILL FBAANQ
WRITE !!
SET DIC="^DPT("
SET DIC(0)="AEQM"
DO ^DIC
if X="^"!(X="")
GOTO Q
if Y<0
GOTO RD
SET DFN=+Y
+1 SET VAR="DFN"
SET VAL=DFN
SET PGM="START^FBAAPI"
DO ZIS^FBAAUTL
if FBPOP
GOTO Q
if IO=IO(0)
SET FBAANQ=1
START USE IO
+1 WRITE !
DO ^FBAADEM
+2 IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:1
+3 if '$ORDER(^FBAA(161.5,"D",DFN,0))
QUIT
+4 WRITE !!,"Patient also has Inpatient Report(s) of Contact with the following date(s):",!
+5 SET I=0
FOR
SET I=$ORDER(^FBAA(161.5,"D",DFN,I))
if 'I
QUIT
SET Y=$PIECE($GET(^FBAA(162.2,I,0)),"^")
DO DD^%DT
WRITE !?10,Y
End DoDot:1
+6 if $DATA(FBAANQ)
GOTO RD
Q KILL DIC,X,Y,FBAAOUT,FBAUT,FBPROG,PTYPE,X1,FBAANQ,DFN,DAT,F,FBCOUNTY,FBDX,FBI,FBRR,FBXX,I,PGM,PI,T,VAL,VAR,Z,ZZ,M,Q
+1 DO CLOSE^FBAAUTL
QUIT
