ABMDTVIS.m

ABMDTVIS ; IHS/ASDST/DMJ - Add/Edit 3P Visit Types ;

 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 ;

 ; IHS/SD/SDR - v2.5 p8 - task 8

 ;    Add prompt for auto-link to do claim splitting

 ;    in claim generator

 ;

START ;START HERE

 K DIC,ABM

 W ! S DIC="^ABMDVTYP(",DIC(0)="QEAML",DIC("A")="Select VISIT TYPE: " D ^DIC

 Q:+Y<1!$D(DTOUT)!$D(DUOUT)

 S ABMVT=+Y

 I $P($G(^ABMDVTYP(+Y,0)),U,3)'="" W "  ","(uneditable) ??",*7 D AUTOLINK G START

 I $P($G(^ABMDVTYP(+Y,0)),U,3)="" D

 .S DR=$S('$P(^ABMDVTYP(+Y,0),U,3):".01;",1:"")_".02;1"

 .S DA=+Y,DIE="^ABMDVTYP(" D ^DIE

 D AUTOLINK

 G XIT

AUTOLINK ; prompt for 8-pages

 W !

 F  D  Q:+ABMY<0!$D(DTOUT)!$D(DUOUT)

 .K DIC

 .S DA(1)=ABMVT

 .S DIC="^ABMDVTYP("_DA(1)_",2,"

 .S DIC(0)="QEAML"

 .S DIC("A")="AUTO-LINK to PCC file:"

 .S DIC("P")=$P(^DD(9002274.8,2,0),U,2)

 .D ^DIC K DIC

 .S ABMY=Y

 .Q:+ABMY<0

 .S DIE="^ABMDVTYP("_DA(1)_",2,"

 .S DA=+Y

 .S DR=".01;.02Delete from original claim?"

 .D ^DIE

 Q

 ;

XIT ;

 K ABM,DIR,DR,DIE,ABMVT,ABMY

 Q

ABMDTVIS  ; IHS/ASDST/DMJ - Add/Edit 3P Visit Types ;

 +1       ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 +2       ;

 +3       ; IHS/SD/SDR - v2.5 p8 - task 8

 +4       ;    Add prompt for auto-link to do claim splitting

 +5       ;    in claim generator

 +6       ;

START     ;START HERE

 +1        KILL DIC,ABM

 +2        WRITE !

           SET DIC="^ABMDVTYP("

           SET DIC(0)="QEAML"

           SET DIC("A")="Select VISIT TYPE: "

           DO ^DIC

 +3        IF +Y<1!$DATA(DTOUT)!$DATA(DUOUT)

               QUIT 

 +4        SET ABMVT=+Y

 +5        IF $PIECE($GET(^ABMDVTYP(+Y,0)),U,3)'=""

               WRITE "  ","(uneditable) ??",*7

               DO AUTOLINK

               GOTO START

 +6        IF $PIECE($GET(^ABMDVTYP(+Y,0)),U,3)=""

               Begin DoDot:1

 +7                SET DR=$SELECT('$PIECE(^ABMDVTYP(+Y,0),U,3):".01;",1:"")_".02;1"

 +8                SET DA=+Y

                   SET DIE="^ABMDVTYP("

                   DO ^DIE

               End DoDot:1

 +9        DO AUTOLINK

 +10       GOTO XIT

AUTOLINK  ; prompt for 8-pages

 +1        WRITE !

 +2        FOR 

               Begin DoDot:1

 +3                KILL DIC

 +4                SET DA(1)=ABMVT

 +5                SET DIC="^ABMDVTYP("_DA(1)_",2,"

 +6                SET DIC(0)="QEAML"

 +7                SET DIC("A")="AUTO-LINK to PCC file:"

 +8                SET DIC("P")=$PIECE(^DD(9002274.8,2,0),U,2)

 +9                DO ^DIC

                   KILL DIC

 +10               SET ABMY=Y

 +11               IF +ABMY<0

                       QUIT 

 +12               SET DIE="^ABMDVTYP("_DA(1)_",2,"

 +13               SET DA=+Y

 +14               SET DR=".01;.02Delete from original claim?"

 +15               DO ^DIE

               End DoDot:1

               IF +ABMY<0!$DATA(DTOUT)!$DATA(DUOUT)

                   QUIT 

 +16       QUIT 

 +17      ;

XIT       ;

 +1        KILL ABM,DIR,DR,DIE,ABMVT,ABMY

 +2        QUIT