Changeset 623 for WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEPA.m

Timestamp:

Dec 4, 2009, 12:11:15 AM (14 years ago)

Author:

George Lilly

Message:

revised back to 6/30/08 version

File:

• WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEPA.m (modified) (1 diff)

WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEPA.m

@@ -1 @@
-IBCEPA  ;ALB/WCJ - Provider ID functions - Care Units ;21-OCT-2005
-        ;;2.0;INTEGRATED BILLING;**320,348,377**;21-MAR-94;Build 23
-        ;;Per VHA Directive 2004-038, this routine should not be modified.
-        ;
-EN      ; -- main entry point for IBCE 2ND PRVID CARE UNIT MAINT
-        D EN^VALM("IBCE 2ND PRVID CARE UNIT MAINT")
-        Q
-        ;
-HDR     ; -- header code
-        K VALMHDR
-        S VALMHDR(1)=" "
-        S VALMHDR(2)="Insurance Co: "_$S('$G(IBALL)&$G(IBINS):$P($G(^DIC(36,+IBINS,0)),U),1:"ALL")
-        Q
-        ;
-INIT    ; -- init variables and list array
-        N DIR,Y
-        I '$G(IBINS) D  I +Y<0 S VALMQUIT=1 Q
-        . S DIR(0)="PA^DIC(36,:AEMQ",DIR("A")="Select INSURANCE CO: ",DIR("?")="Select an INSURANCE CO to display its care units"
-        . D ^DIR K DIR
-        . I $D(DTOUT)!$D(DUOUT) S Y=-2 Q
-        . I Y>0 S IBINS=+Y Q
-        ;
-        D BLD
-        Q
-        ;
-BLD     ;
-        D CLEAN^VALM10
-        K ^TMP("IBPRV_CU",$J)
-        N TAR,MSG,I,D0,IBCT,Z,DIV,SCREEN
-        ;
-        S VALMBG=1
-        ;
-        ; Get all care units for this insurance company that have a division
-        ; If there is no division, then it is part of the other care units code (IBCEP4)
-        ; 
-        S SCREEN="I $P(^(0),U,4)'="""",$P(^(0),U,3)=IBINS"
-        D LIST^DIC(355.95,,"@;.01;.02;.04",,,,,,SCREEN,,"TAR")
-        ;
-        I '+TAR("DILIST",0) D
-        . D SET^VALM10(1,"No CARE UNITs found for this Insurance Company")
-        ;
-        I +TAR("DILIST",0) D
-        . S IBCT=0
-        . F VALMCNT=1:1:+TAR("DILIST",0) D
-        .. S ^TMP("IBPRV_CU",$J,"SORT",TAR("DILIST","ID",VALMCNT,.04),TAR("DILIST",2,VALMCNT))=VALMCNT
-        . S DIV="" F  S DIV=$O(^TMP("IBPRV_CU",$J,"SORT",DIV)) Q:DIV=""  D
-        .. S Z="Division: "_DIV
-        .. S IBCT=IBCT+1
-        .. D SET^VALM10(IBCT,Z)
-        .. S D0=0 F  S D0=$O(^TMP("IBPRV_CU",$J,"SORT",DIV,D0)) Q:'D0  D
-        ... S IN=^TMP("IBPRV_CU",$J,"SORT",DIV,D0)
-        ... S Z=$J("",2)
-        ... S Z=Z_$E(IN_"    ",1,4)_$E(TAR("DILIST","ID",IN,.01),1,36)
-        ... S Z=Z_$J("",40-$L(Z))
-        ... S Z=Z_$E(TAR("DILIST","ID",IN,.02),1,38)
-        ... S IBCT=IBCT+1
-        ... D SET^VALM10(IBCT,Z)
-        ;
-        ; correct the VALMCNT variable - number of lines in the list (not entries)
-        S VALMCNT=+$O(@VALMAR@(""),-1)
-        Q
-        ;
-HELP    ; -- help code
-        S X="?" D DISP^XQORM1 W !!
-        Q
-        ;
-EXIT    ; -- exit code
-        D CLEAN^VALM10
-        K ^TMP("IBPRV_CU",$J)
-        Q
-        ;
-EXPND   ; -- expand code
-        Q
-        ;
-NEW     ; Add care unit
-        ; Assumes IBINS is defined as ins co ien (file 36)
-        ; IB = 0 or null if called from list manager, 1 if not
-        N DIC,DIR,X,Y,Z,D,DA,DR,DIE,DO,DD,DLAYGO,IB95,IBADD,IBOK,IBDIV,MAIN,IBDIVNM
-        ;
-        D FULL^VALM1
-        ; Add an entry - either new care unit/ins co or a combination for
-        ; existing care unit/ins co
-        ;
-        S MAIN=$$MAIN^IBCEP2B()
-        S MAIN=$$EXTERNAL^DILFD(355.92,.05,"",MAIN)
-        S DIC=40.8,DIC("A")="Enter the Division for this Care Unit: ",DIC("B")=MAIN,DIC(0)="AEMQ"
-        S D="B^C"
-        D MIX^DIC1
-        I Y'>0 G NEWQ
-        S IBDIV=+Y
-        S IBDIVNM=$$EXTERNAL^DILFD(355.92,.05,"",IBDIV)
-        ;
-        N SCREEN,TAR,MESS,I
-        S SCREEN="I $P(^(0),U,3)=+$G(IBINS),$P(^(0),U,4)=+$G(IBDIV)"
-        D LIST^DIC(355.95,,.01,,,,,,SCREEN,,"TAR")
-        ;
-ACU     K DIR
-        S I=0
-        I $G(TAR("DILIST",0)) D 
-        . S DIR("?",1)="Current Entries are:"
-        . F I=2:1 Q:'$D(TAR("DILIST",1,I-1))  S DIR("?",I)="     "_TAR("DILIST",1,I-1)
-        . S DIR("?",I)=" "
-        ;
-        S DIR("?",I+1)="You may enter the name of a new Care Unit for this Insurance Company."
-        S DIR("?",I+2)="You can then define a Billing Provider Secondary ID - Billing Screen 3 - for"
-        S DIR("?")="this Care Unit and Insurance Company using the Insurance Company Editor."
-        S DIR("A")="Enter the Care Unit name"
-        S DIR(0)="FO^1:30"
-        D ^DIR
-        I X=""!$G(DUOUT)!$G(DTOUT)!$G(DIROUT) G NEWQ
-        S CAREUNIT=X
-        ; 
-        ; At this point, we have X and it'a not a ? or ^
-        ;
-        K DIC
-        S DIC="^IBA(355.95,",DIC("S")="I $P(^(0),U,3)=+$G(IBINS),$P(^(0),U,4)=+$G(IBDIV)",DIC(0)="EX"
-        D ^DIC
-        ;
-        ; Check if we have an exisitng entry and if so, get out of Dodge (This option was for new care units)
-        I Y>0 D  G ACU
-        . D DISPMESS("This action is for adding new entries, not editing existing entries.")
-        ;
-        ; New entry , validate field
-        N TAR2
-        D FIELD^DID(355.95,.01,"N","INPUT TRANSFORM","TAR2")
-        S X=CAREUNIT
-        X TAR2("INPUT TRANSFORM")
-        I '$D(X) D  G ACU  ; Failed input transform
-        . D DISPMESS("Invalid Format.")
-        ;
-        K DIR
-        S DIR("A")="Are you adding '"_X_"' as a new Care Unit for '"_IBDIVNM_"'"
-        S DIR("B")="N"
-        S DIR(0)="Y"
-        D ^DIR
-        I Y=0 G ACU
-        I Y["^" G NEWQ
-        ;
-        ; If it got this far, we have an exact match or a new entry.   
-        S X=CAREUNIT
-        S DIC="^IBA(355.95,",DIC("S")="I $P(^(0),U,3)=+$G(IBINS),$P(^(0),U,4)=+$G(IBDIV)",DIC(0)="XL",DLAYGO=355.95
-        S DIC("DR")=".03////"_+$G(IBINS)_";.04////"_$G(IBDIV)
-        D ^DIC
-        I Y>0 D
-        . S DA=+Y,DIE="^IBA(355.95,"
-        . S DR=".02Enter the Care Unit Description"
-        . D ^DIE
-        D BLD
-        ;
-NEWQ    S VALMBCK="R"
-        Q
-        ;
-CHANGE  ; Edit care unit
-        ; Assumes IBINS is defined as ins co ien (file 36)
-        ;
-        D FULL^VALM1
-        ;
-        N X,Y,Z,D,DA,DD,DIC,DIK,DIR,IBDIV,CAREUNIT,SCREEN,TAR,DIVISION,I
-        ;
-        S SCREEN="I $P(^(0),U,3)=+$G(IBINS),$P(^(0),U,4)]"""""
-        D LIST^DIC(355.95,,".01;.04",,,,,,SCREEN,,"TAR")
-        ;
-        I '+$G(TAR("DILIST",0)) D  G CHANGEQ
-        .D DISPMESS("No Care Units Defined for this insurance company.")
-        ;
-        ; Store all Divisons with at least one care unit in DIVISION array
-        F I=1:1 Q:'$D(TAR("DILIST","ID",I,.04))  D
-        . S DIVISION(TAR("DILIST","ID",I,.04))=""
-        ;
-        ; Only allow divisions that have care units to be selected
-        S DIC=40.8
-        S DIC("A")="Enter the Division for this Care Unit: "
-        S DIC(0)="AEMQ"
-        S DIC("S")="I $D(DIVISION($P(^(0),U)))"
-        S D="B^C"
-        D MIX^DIC1
-        I Y'>0 G CHANGEQ
-        S IBDIV=+Y
-        S DA=$$SEL($P(Y,U,2)) I 'DA G CHANGEQ
-        S DIE=355.95
-        S DR=".01Care Unit;.04Division;.02Description"
-        D ^DIE
-        ;
-        D BLD
-        ;
-CHANGEQ S VALMBCK="R"
-        Q
-        ;
-DEL     ; Delete a Care Unit
-        ; Assumes IBINS is defined as ins co ien (file 36)
-        ; 
-        D FULL^VALM1
-        N X,Y,Z,D,DA,DD,DIC,DIK,DIR,IBDIV,CAREUNIT,SCREEN,TAR,DIVISION
-        ;
-        S SCREEN="I $P(^(0),U,3)=+$G(IBINS),$P(^(0),U,4)]"""""
-        D LIST^DIC(355.95,,".01;.04",,,,,,SCREEN,,"TAR")
-        ;
-        I '+$G(TAR("DILIST",0)) D  G DELQ
-        .D DISPMESS("No Care Units Defined for this insurance company.")
-        ;
-        ; Store all Divisons with at least one care unit in DIVISION array
-        F I=1:1 Q:'$D(TAR("DILIST","ID",I,.04))  D
-        . S DIVISION(TAR("DILIST","ID",I,.04))=""
-        ;
-        ; Only allow divisions that have care units to be selected
-        S DIC=40.8
-        S DIC("A")="Enter the Division for this Care Unit: "
-        S DIC(0)="AEMQ"
-        S DIC("S")="I $D(DIVISION($P(^(0),U)))"
-        S D="B^C"
-        D MIX^DIC1
-        I Y'>0 G DELQ
-        S IBDIV=+Y
-        S CAREUNIT=$$SEL($P(Y,U,2)) I 'CAREUNIT G DELQ
-        ;
-        I $D(^IBA(355.92,"AC",+Y)) D  G DELQ
-        . S DIR(0)="EA"
-        . S DIR("A",1)="IDs that are assigned to the Care Unit in the Insurance Company Editor must be"
-        . S DIR("A",2)="deleted before deleting the Care Unit."
-        . S DIR("A")="Press return to continue "
-        . W ! D ^DIR K DIR
-        ;
-        S DIR("A")="OK to Delete: "
-        S DIR("B")="No"
-        S DIR(0)="YAO"
-        D ^DIR
-        I '$G(Y) G DELQ
-        K DIR
-        ;
-        S DA=CAREUNIT
-        S DIK="^IBA("_355.95_","
-        D ^DIK
-        ;
-        D BLD
-        ;
-DELQ    S VALMBCK="R"
-        Q
-        ;
-DISPMESS(MESS)  ;
-        N DIR,X,Y
-        S DIR(0)="EA",DIR("A",1)=MESS
-        S DIR("A")="PRESS ENTER to continue "
-        D ^DIR
-        Q
-        ;
-SEL(DIV)        ; select care unit for a given division
-        ; DIV - name of division
-        ; returns ien of selected care unit, or 0 if nothing is selected
-        N DIR,I,IEN,MIN,MAX,X,Y
-        I $G(DIV)="" Q 0
-        S IEN=0
-        S I=$O(^TMP("IBPRV_CU",$J,"SORT",DIV,"")),MIN=$G(^TMP("IBPRV_CU",$J,"SORT",DIV,I))
-        S I=$O(^TMP("IBPRV_CU",$J,"SORT",DIV,""),-1),MAX=$G(^TMP("IBPRV_CU",$J,"SORT",DIV,I))
-        I MIN=MAX S IEN=I
-        I MIN'=MAX D
-        .S DIR("A")="Select CARE UNITS",DIR(0)="N^"_MIN_":"_MAX_":0" D ^DIR
-        .Q:$D(DTOUT)!$D(DUOUT)
-        .S I="" F  S I=$O(^TMP("IBPRV_CU",$J,"SORT",DIV,I)) Q:I=""!(IEN>0)  S:$G(^TMP("IBPRV_CU",$J,"SORT",DIV,I))=Y IEN=I
-        .Q
-        Q IEN
+IBCEPA ;ALB/WCJ - Provider ID functions - Care Units ;21-OCT-2005
+ ;;2.0;INTEGRATED BILLING;**320,348**;21-MAR-94;Build 5
+EN ; -- main entry point for IBCE 2ND PRVID CARE UNIT MAINT
+ D EN^VALM("IBCE 2ND PRVID CARE UNIT MAINT")
+ Q
+ ;
+HDR ; -- header code
+ K VALMHDR
+ S VALMHDR(1)=" "
+ S VALMHDR(2)="Insurance Co: "_$S('$G(IBALL)&$G(IBINS):$P($G(^DIC(36,+IBINS,0)),U),1:"ALL")
+ Q
+ ;
+INIT ; -- init variables and list array
+ N DIR,Y
+ I '$G(IBINS) D  I +Y<0 S VALMQUIT=1 Q
+ . S DIR(0)="PA^DIC(36,:AEMQ",DIR("A")="Select INSURANCE CO: ",DIR("?")="Select an INSURANCE CO to display its care units"
+ . D ^DIR K DIR
+ . I $D(DTOUT)!$D(DUOUT) S Y=-2 Q
+ . I Y>0 S IBINS=+Y Q
+ ;
+ D BLD
+ Q
+ ;
+BLD ;
+ D CLEAN^VALM10
+ K ^TMP("IBPRV_CU",$J)
+ N TAR,MSG,I,D0,IBLCT,Z,DIV,SCREEN
+ ;
+ S VALMBG=1
+ ;
+ ; Get all care units for this insurance company that have a division
+ ; If there is no division, then it is part of the other care units code (IBCEP4)
+ ; 
+ S SCREEN="I $P(^(0),U,4)'="""",$P(^(0),U,3)=IBINS"
+ D LIST^DIC(355.95,,"@;.01;.02;.04",,,,,,SCREEN,,"TAR")
+ ;
+ I '+TAR("DILIST",0) D
+ . D SET^VALM10(1,"No CARE UNITs found for this Insurance Company")
+ ;
+ I +TAR("DILIST",0) D
+ . S IBCT=0
+ . F VALMCNT=1:1:+TAR("DILIST",0) D
+ .. S ^TMP("IBPRV_CU",$J,"SORT",TAR("DILIST","ID",VALMCNT,.04),TAR("DILIST",2,VALMCNT))=VALMCNT
+ . S DIV="" F  S DIV=$O(^TMP("IBPRV_CU",$J,"SORT",DIV)) Q:DIV=""  D
+ .. S Z="Division: "_DIV
+ .. S IBCT=IBCT+1
+ .. D SET^VALM10(IBCT,Z)
+ .. S D0=0 F  S D0=$O(^TMP("IBPRV_CU",$J,"SORT",DIV,D0)) Q:'D0  D
+ ... S IN=^TMP("IBPRV_CU",$J,"SORT",DIV,D0)
+ ... S Z=$J("",2)
+ ... S Z=Z_$E(TAR("DILIST","ID",IN,.01),1,36)
+ ... S Z=Z_$J("",40-$L(Z))
+ ... S Z=Z_$E(TAR("DILIST","ID",IN,.02),1,38)
+ ... S IBCT=IBCT+1
+ ... D SET^VALM10(IBCT,Z)
+ Q
+ ;
+HELP ; -- help code
+ S X="?" D DISP^XQORM1 W !!
+ Q
+ ;
+EXIT ; -- exit code
+ D CLEAN^VALM10
+ Q
+ ;
+EXPND ; -- expand code
+ Q
+ ;
+NEW ; Add care unit
+ ; Assumes IBINS is defined as ins co ien (file 36)
+ ; IB = 0 or null if called from list manager, 1 if not
+ N DIC,DIR,X,Y,Z,DA,DR,DIE,DO,DD,DLAYGO,IB95,IBADD,IBOK,IBDIV,MAIN,IBDIVNM
+ ;
+ D FULL^VALM1
+ ; Add an entry - either new care unit/ins co or a combination for
+ ; existing care unit/ins co
+ ;
+ S MAIN=$$MAIN^IBCEP2B()
+ S MAIN=$$EXTERNAL^DILFD(355.92,.05,"",MAIN)
+ S DIC=40.8,DIC("A")="Enter the Division for this Care Unit: ",DIC("B")=MAIN,DIC(0)="AEMQ"
+ D ^DIC
+ I Y'>0 G NEWQ
+ S IBDIV=+Y
+ S IBDIVNM=$$EXTERNAL^DILFD(355.92,.05,"",IBDIV)
+ ;
+ N SCREEN,TAR,MESS,I
+ S SCREEN="I $P(^(0),U,3)=+$G(IBINS),$P(^(0),U,4)=+$G(IBDIV)"
+ D LIST^DIC(355.95,,.01,,,,,,SCREEN,,"TAR")
+ ;
+ACU K DIR
+ S I=0
+ I $G(TAR("DILIST",0)) D 
+ . S DIR("?",1)="Current Entries are:"
+ . F I=2:1 Q:'$D(TAR("DILIST",1,I-1))  S DIR("?",I)="     "_TAR("DILIST",1,I-1)
+ . S DIR("?",I)=" "
+ ;
+ S DIR("?",I+1)="You may enter the name of a new Care Unit for this Insurance Company."
+ S DIR("?",I+2)="You can then define a Billing Provider Secondary ID - Billing Screen 3 - for"
+ S DIR("?")="this Care Unit and Insurance Company using the Insurance Company Editor."
+ S DIR("A")="Enter the Care Unit name"
+ S DIR(0)="FO^1:30"
+ D ^DIR
+ I X=""!$G(DUOUT)!$G(DTOUT)!$G(DIROUT) G NEWQ
+ S CAREUNIT=X
+ ; 
+ ; At this point, we have X and it'a not a ? or ^
+ ;
+ K DIC
+ S DIC="^IBA(355.95,",DIC("S")="I $P(^(0),U,3)=+$G(IBINS),$P(^(0),U,4)=+$G(IBDIV)",DIC(0)="EX"
+ D ^DIC
+ ;
+ ; Check if we have an exisitng entry and if so, get out of Dodge (This option was for new care units)
+ I Y>0 D  G ACU
+ . D DISPMESS("This action is for adding new entries, not editing existing entries.")
+ ;
+ ; New entry , validate field
+ N TAR2
+ D FIELD^DID(355.95,.01,"N","INPUT TRANSFORM","TAR2")
+ S X=CAREUNIT
+ X TAR2("INPUT TRANSFORM")
+ I '$D(X) D  G ACU  ; Failed input transform
+ . D DISPMESS("Invalid Format.")
+ ;
+ K DIR
+ S DIR("A")="Are you adding '"_X_"' as a new Care Unit for '"_IBDIVNM_"'"
+ S DIR("B")="N"
+ S DIR(0)="Y"
+ D ^DIR
+ I Y=0 G ACU
+ I Y["^" G NEWQ
+ ;
+ ; If it got this far, we have an exact match or a new entry.   
+ S X=CAREUNIT
+ S DIC="^IBA(355.95,",DIC("S")="I $P(^(0),U,3)=+$G(IBINS),$P(^(0),U,4)=+$G(IBDIV)",DIC(0)="XL",DLAYGO=355.95
+ S DIC("DR")=".03////"_+$G(IBINS)_";.04////"_$G(IBDIV)
+ D ^DIC
+ I Y>0 D
+ . S DA=+Y,DIE="^IBA(355.95,"
+ . S DR=".02Enter the Care Unit Description"
+ . D ^DIE
+ D BLD
+ ;
+NEWQ S VALMBCK="R"
+ Q
+ ;
+CHANGE ; Edit care unit
+ ; Assumes IBINS is defined as ins co ien (file 36)
+ ; 
+ D FULL^VALM1
+ ;
+ N X,Y,Z,DA,DD,DIC,DIK,DIR,IBDIV,CAREUNIT,SCREEN,TAR,DIVISION
+ ;
+ S SCREEN="I $P(^(0),U,3)=+$G(IBINS),$P(^(0),U,4)]"""""
+ D LIST^DIC(355.95,,".01;.04",,,,,,SCREEN,,"TAR")
+ ;
+ I '+$G(TAR("DILIST",0)) D  G CHANGEQ
+ .D DISPMESS("No Care Units Defined for this insurance company.")
+ ;
+ ; Store all Divisons with at least one care unit in DIVISION array
+ F I=1:1 Q:'$D(TAR("DILIST","ID",I,.04))  D
+ . S DIVISION(TAR("DILIST","ID",I,.04))=""
+ ;
+ ; Only allow divisions that have care units to be selected
+ S DIC=40.8
+ S DIC("A")="Enter the Division for this Care Unit: "
+ S DIC(0)="AEMQ"
+ S DIC("S")="I $D(DIVISION($P(^(0),U)))"
+ D ^DIC
+ I Y'>0 G CHANGEQ
+ S IBDIV=+Y
+ ;
+ S DIC("A")="Enter the Care Unit name: "
+ S DIC=355.95,DIC("S")="I $P(^(0),U,3)=+$G(IBINS),$P(^(0),U,4)=+$G(IBDIV)",DIC(0)="AEMQ"
+ D ^DIC
+ I Y<1 G CHANGEQ
+ ;
+ S DA=+Y,DIE=355.95
+ S DR=".01Care Unit;.04Division;.02Description"
+ D ^DIE
+ ;
+ D BLD
+ ;
+CHANGEQ S VALMBCK="R"
+ Q
+ ;
+DEL ; Delete a Care Unit
+ ; Assumes IBINS is defined as ins co ien (file 36)
+ ; 
+ D FULL^VALM1
+ N X,Y,Z,DA,DD,DIC,DIK,DIR,IBDIV,CAREUNIT,SCREEN,TAR,DIVISION
+ ;
+ S SCREEN="I $P(^(0),U,3)=+$G(IBINS),$P(^(0),U,4)]"""""
+ D LIST^DIC(355.95,,".01;.04",,,,,,SCREEN,,"TAR")
+ ;
+ I '+$G(TAR("DILIST",0)) D  G DELQ
+ .D DISPMESS("No Care Units Defined for this insurance company.")
+ ;
+ ; Store all Divisons with at least one care unit in DIVISION array
+ F I=1:1 Q:'$D(TAR("DILIST","ID",I,.04))  D
+ . S DIVISION(TAR("DILIST","ID",I,.04))=""
+ ;
+ ; Only allow divisions that have care units to be selected
+ S DIC=40.8
+ S DIC("A")="Enter the Division for this Care Unit: "
+ S DIC(0)="AEMQ"
+ S DIC("S")="I $D(DIVISION($P(^(0),U)))"
+ D ^DIC
+ I Y'>0 G DELQ
+ S IBDIV=+Y
+ ;
+ K DIC
+ S DIC("A")="Enter the Care Unit name: "
+ S DIC=355.95,DIC("S")="I $P(^(0),U,3)=+$G(IBINS),$P(^(0),U,4)=+$G(IBDIV)",DIC(0)="AEMQ"
+ D ^DIC
+ I Y<1 G DELQ
+ S CAREUNIT=+Y
+ ;
+ I $D(^IBA(355.92,"AC",+Y)) D  G DELQ
+ . S DIR(0)="EA"
+ . S DIR("A",1)="IDs that are assigned to the Care Unit in the Insurance Company Editor must be"
+ . S DIR("A",2)="deleted before deleting the Care Unit."
+ . S DIR("A")="Press return to continue "
+ . W ! D ^DIR K DIR
+ ;
+ S DIR("A")="OK to Delete: "
+ S DIR("B")="No"
+ S DIR(0)="YAO"
+ D ^DIR
+ I '$G(Y) G DELQ
+ K DIR
+ ;
+ S DA=CAREUNIT
+ S DIK="^IBA("_355.95_","
+ D ^DIK
+ ;
+ D BLD
+ ;
+DELQ S VALMBCK="R"
+ Q
+ ;
+DISPMESS(MESS) ;
+ N DIR,X,Y
+ S DIR(0)="EA",DIR("A",1)=MESS
+ S DIR("A")="PRESS ENTER to continue "
+ D ^DIR
+ Q
+ ;