IBDFN1 ;ALB/CJM - ENCOUNTER FORM - INTERFACE ROUTINES ;NOV 16,1992
;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
CLINIC ;returns clinic name
S @IBARY=$S($G(IBCLINIC):$P($G(^SC(IBCLINIC,0)),"^",1),1:"UNSPECIFIED")
Q
DIVISION ;returns the name of the division of IBCLINIC in ien^name format
Q:'$G(IBCLINIC)
S @IBARY=$P($$DIVISION^IBDF1B5(+IBCLINIC),"^",2)
Q
INST ;returns the name of the institution of IBCLINIC
Q:'$G(IBCLINIC)
N INST
S INST=$P($G(^SC(IBCLINIC,0)),"^",4)
I 'INST S INST=+$$DIVISION^IBDF1B5(+IBCLINIC) S:INST INST=$P($$SITE^VASITE(,INST),"^")
S:INST INST=$$GET1^DIQ(4,INST,.01)
S @IBARY=INST
Q
;
SAMEDAY ;get all future, same day appts
N TO
S TO=(IBAPPT\1)+.999999
D GETAPPTS(TO)
Q
;
ALLFUTR ;get all future appts
D GETAPPTS()
Q
;
CLNCFUTR ;get all future appts for the same clinic
Q:'$G(IBCLINIC)
D GETAPPTS("",IBCLINIC)
Q
;
GETAPPTS(TO,CLINIC) ;
Q:'$G(DFN)!('$G(IBAPPT))
N CNT,SUB,NODE,TIME
K VASD,VADPT
S VASD("F")=IBAPPT
S:$G(TO) VASD("T")=TO
S:$G(CLINIC) VASD("C",CLINIC)=""
D SDA^VADPT
I '$G(VAERR) S (SUB,CNT)=0 F S SUB=$O(^UTILITY("VASD",$J,SUB)) Q:'SUB D
.S NODE=$G(^UTILITY("VASD",$J,SUB,"E")) Q:NODE=""
.S CNT=CNT+1
.S TIME=$P(NODE,"^",1)
.S @IBARY@(CNT)=$P(TIME,"@",1)_"^"_$P(TIME,"@",2)_"^"_NODE
K ^UTILITY("VASD",$J),VADPT,VASD,VAERR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDFN1 1358 printed Nov 22, 2024@18:02:57 Page 2
IBDFN1 ;ALB/CJM - ENCOUNTER FORM - INTERFACE ROUTINES ;NOV 16,1992
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
CLINIC ;returns clinic name
+1 SET @IBARY=$SELECT($GET(IBCLINIC):$PIECE($GET(^SC(IBCLINIC,0)),"^",1),1:"UNSPECIFIED")
+2 QUIT
DIVISION ;returns the name of the division of IBCLINIC in ien^name format
+1 if '$GET(IBCLINIC)
QUIT
+2 SET @IBARY=$PIECE($$DIVISION^IBDF1B5(+IBCLINIC),"^",2)
+3 QUIT
INST ;returns the name of the institution of IBCLINIC
+1 if '$GET(IBCLINIC)
QUIT
+2 NEW INST
+3 SET INST=$PIECE($GET(^SC(IBCLINIC,0)),"^",4)
+4 IF 'INST
SET INST=+$$DIVISION^IBDF1B5(+IBCLINIC)
if INST
SET INST=$PIECE($$SITE^VASITE(,INST),"^")
+5 if INST
SET INST=$$GET1^DIQ(4,INST,.01)
+6 SET @IBARY=INST
+7 QUIT
+8 ;
SAMEDAY ;get all future, same day appts
+1 NEW TO
+2 SET TO=(IBAPPT\1)+.999999
+3 DO GETAPPTS(TO)
+4 QUIT
+5 ;
ALLFUTR ;get all future appts
+1 DO GETAPPTS()
+2 QUIT
+3 ;
CLNCFUTR ;get all future appts for the same clinic
+1 if '$GET(IBCLINIC)
QUIT
+2 DO GETAPPTS("",IBCLINIC)
+3 QUIT
+4 ;
GETAPPTS(TO,CLINIC) ;
+1 if '$GET(DFN)!('$GET(IBAPPT))
QUIT
+2 NEW CNT,SUB,NODE,TIME
+3 KILL VASD,VADPT
+4 SET VASD("F")=IBAPPT
+5 if $GET(TO)
SET VASD("T")=TO
+6 if $GET(CLINIC)
SET VASD("C",CLINIC)=""
+7 DO SDA^VADPT
+8 IF '$GET(VAERR)
SET (SUB,CNT)=0
FOR
SET SUB=$ORDER(^UTILITY("VASD",$JOB,SUB))
if 'SUB
QUIT
Begin DoDot:1
+9 SET NODE=$GET(^UTILITY("VASD",$JOB,SUB,"E"))
if NODE=""
QUIT
+10 SET CNT=CNT+1
+11 SET TIME=$PIECE(NODE,"^",1)
+12 SET @IBARY@(CNT)=$PIECE(TIME,"@",1)_"^"_$PIECE(TIME,"@",2)_"^"_NODE
End DoDot:1
+13 KILL ^UTILITY("VASD",$JOB),VADPT,VASD,VAERR
+14 QUIT
