IBDFN1.m

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 ---IBDFN1   1358     printed  Apr 09, 2024@20:54:07                                                                                                                                                                                                      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