IBDF18D.m

IBDF18D ;ALB/CJM/AAS - ENCOUNTER FORM - form type utilities ;04-OCT-94

 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997

 ;

FORMTYPE(SOURCE) ;creates an entry in the FORM DEFINITION TABLE

 ; -- input  SOURCE = the source of the form, ie

 ;                     IB=1

 ;                     PANDAS=2

 ;                     TELEFORM=3

 ;                     OTHER=99

 ; -- Output Returns the ien of the table created, "" if not created

 ;

 Q:'SOURCE ""

 N IBFORMID,ID,NODE,DIC,DIE,DA,DINUM,D0,DD,DIK,DINUM,DLAYGO

 S ID=""

 ;

 L +^IBD(357.97,1,.01):3

 S ID=$P($G(^IBD(357.97,1,0)),"^")

 K DIC,D0,DD,DA,DO

 S DIC="^IBD(357.95,",DIC(0)="L",DLAYGO=357.95

 F ID=ID+1:1 L:$D(^IBD(357.95,(ID-1))) -^IBD(357.95,(ID-1)) I ID>0,'$D(^IBD(357.95,ID)) L +^IBD(357.95,ID):1 I $T,'$D(^IBD(357.95,ID)) S (X,DINUM)=ID D FILE^DICN Q:+Y>0

 S $P(^IBD(357.97,1,0),"^")=ID

 L -^IBD(357.97,1,.01)

 K DIC,DIE,DA,DINUM,DLAYGO,DO,D0,DD

 S IBFORMID=$S(+Y<0:"",1:+Y) I 'IBFORMID D LOGERR^IBDF18E2(3570003)

 ;

 I IBFORMID D

 .S $P(^IBD(357.95,IBFORMID,0),"^",3)=SOURCE,^IBD(357.95,IBFORMID,1,0)="^357.951I^0^0",^IBD(357.95,IBFORMID,2,0)="^357.952I^0^0",^IBD(357.95,IBFORMID,3,0)="^357.953^0^0"

 .S DIK="^IBD(357.95,",DA=IBFORMID D IX1^DIK

 K DIK,X,DA

 Q IBFORMID

IBDF18D   ;ALB/CJM/AAS - ENCOUNTER FORM - form type utilities ;04-OCT-94

 +1       ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997

 +2       ;

FORMTYPE(SOURCE) ;creates an entry in the FORM DEFINITION TABLE

 +1       ; -- input  SOURCE = the source of the form, ie

 +2       ;                     IB=1

 +3       ;                     PANDAS=2

 +4       ;                     TELEFORM=3

 +5       ;                     OTHER=99

 +6       ; -- Output Returns the ien of the table created, "" if not created

 +7       ;

 +8        IF 'SOURCE

               QUIT ""

 +9        NEW IBFORMID,ID,NODE,DIC,DIE,DA,DINUM,D0,DD,DIK,DINUM,DLAYGO

 +10       SET ID=""

 +11      ;

 +12       LOCK +^IBD(357.97,1,.01):3

 +13       SET ID=$PIECE($GET(^IBD(357.97,1,0)),"^")

 +14       KILL DIC,D0,DD,DA,DO

 +15       SET DIC="^IBD(357.95,"

           SET DIC(0)="L"

           SET DLAYGO=357.95

 +16       FOR ID=ID+1:1

               IF $DATA(^IBD(357.95,(ID-1)))

                   LOCK -^IBD(357.95,(ID-1))

               IF ID>0

                   IF '$DATA(^IBD(357.95,ID))

                       LOCK +^IBD(357.95,ID):1

                       IF $TEST

                           IF '$DATA(^IBD(357.95,ID))

                               SET (X,DINUM)=ID

                               DO FILE^DICN

                               IF +Y>0

                                   QUIT 

 +17       SET $PIECE(^IBD(357.97,1,0),"^")=ID

 +18       LOCK -^IBD(357.97,1,.01)

 +19       KILL DIC,DIE,DA,DINUM,DLAYGO,DO,D0,DD

 +20       SET IBFORMID=$SELECT(+Y<0:"",1:+Y)

           IF 'IBFORMID

               DO LOGERR^IBDF18E2(3570003)

 +21      ;

 +22       IF IBFORMID

               Begin DoDot:1

 +23               SET $PIECE(^IBD(357.95,IBFORMID,0),"^",3)=SOURCE

                   SET ^IBD(357.95,IBFORMID,1,0)="^357.951I^0^0"

                   SET ^IBD(357.95,IBFORMID,2,0)="^357.952I^0^0"

                   SET ^IBD(357.95,IBFORMID,3,0)="^357.953^0^0"

 +24               SET DIK="^IBD(357.95,"

                   SET DA=IBFORMID

                   DO IX1^DIK

               End DoDot:1

 +25       KILL DIK,X,DA

 +26       QUIT IBFORMID