- 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