| [613] | 1 | ECXWRDX ;ALB/JAP - Assign DSS Dept. to Ward ;July 16, 1998
|
|---|
| 2 | ;;3.0;DSS EXTRACTS;**8**;Dec 22, 1997
|
|---|
| 3 | ;
|
|---|
| 4 | EN ;entry point from menu option
|
|---|
| 5 | ;lookup ward
|
|---|
| 6 | N DIC,DIR,DTOUT,DUOUT,DIRUT,X,Y,DSSID,OUT
|
|---|
| 7 | S DIC(0)="AEMQZ",DIC="^DIC(42," D ^DIC G:$D(DTOUT)!($D(DUOUT))!(+Y<1) EXIT
|
|---|
| 8 | S ECXWARD=+Y,DSSID=""
|
|---|
| 9 | S DR=".01;.02;.03;.015;.017",DIQ(0)="IE",DIQ="ECX",DA=ECXWARD,DIC="^DIC(42," K ECX D EN^DIQ1
|
|---|
| 10 | S ECXWARD=ECXWARD_U_$G(ECX(42,+ECXWARD,.01,"E"))
|
|---|
| 11 | W !!,"Ward: ",?18,$P(ECXWARD,U,2)
|
|---|
| 12 | S ECXDIV=$G(ECX(42,+ECXWARD,.015,"I"))
|
|---|
| 13 | I +ECXDIV>0 D
|
|---|
| 14 | .;division may not exist in file #727.3, or it may not have a dss id
|
|---|
| 15 | .S DSSID=$P($G(^ECX(727.3,+ECXDIV,0)),U,2) S:DSSID="" DSSID="Not defined"
|
|---|
| 16 | .S ECXDIV=ECXDIV_U_ECX(42,+ECXWARD,.015,"E")_"/"_$P(^DG(40.8,+ECXDIV,0),U,2)_" <"_DSSID_">"
|
|---|
| 17 | W !,"Ward Bedsection: ",?18,$G(ECX(42,+ECXWARD,.02,"E"))
|
|---|
| 18 | W !,"Ward Specialty: ",?18,$G(ECX(42,+ECXWARD,.017,"E"))
|
|---|
| 19 | W !,"Ward Service: ",?18,$G(ECX(42,+ECXWARD,.03,"E"))
|
|---|
| 20 | I +ECXDIV>0 W !,"Division: ",?18,$P(ECXDIV,U,2)
|
|---|
| 21 | ;dss id for division is needed to derive dss dept code
|
|---|
| 22 | I DSSID["Not" D G EN
|
|---|
| 23 | .W !!,"Cannot proceed with assignment of DSS Department code for ward,"
|
|---|
| 24 | .W !,"because the "_ECX(42,+ECXWARD,.015,"E")_" division does not have a DSS Division Identifier."
|
|---|
| 25 | .W !
|
|---|
| 26 | .W !,"Use the Enter/Edit DSS Division Identifier option to associate an"
|
|---|
| 27 | .W !,"identifier with "_ECX(42,+ECXWARD,.015,"E")_"."
|
|---|
| 28 | .I $E(IOST)="C" D
|
|---|
| 29 | ..S SS=22-$Y F JJ=1:1:SS W !
|
|---|
| 30 | ..S DIR(0)="E" W ! D ^DIR K DIR,JJ,SS W !
|
|---|
| 31 | I ECXDIV="" D G EN
|
|---|
| 32 | .W !!,"Cannot proceed with assignment of DSS Department code for ward,"
|
|---|
| 33 | .W !,"because the ward is not associated with a Medical Center Division."
|
|---|
| 34 | .W !
|
|---|
| 35 | .I $E(IOST)="C" D
|
|---|
| 36 | ..S SS=22-$Y F JJ=1:1:SS W !
|
|---|
| 37 | ..S DIR(0)="E" W ! D ^DIR K DIR W !
|
|---|
| 38 | I '$D(ECX(727.4,+ECXWARD)) D
|
|---|
| 39 | .S (X,DINUM)=+ECXWARD,DIC(0)="L",DLAYGO=727.4,DIC="^ECX(727.4,"
|
|---|
| 40 | .K DD,DO D FILE^DICN K DIC,DINUM,DLAYGO,X,Y
|
|---|
| 41 | S DR="1;",DIQ(0)="E",DIQ="ECX",DA=+ECXWARD,DIC="^ECX(727.4," K ECX D EN^DIQ1
|
|---|
| 42 | S ECXDEPT=$G(ECX(727.4,+ECXWARD,1,"E"))
|
|---|
| 43 | S ECXDEPT0=ECXDEPT K X,Y
|
|---|
| 44 | ;if ward has dss dept, then edit
|
|---|
| 45 | I ECXDEPT]"" D
|
|---|
| 46 | .D REVERSE^ECXDSSD(ECXDEPT,.ECXDESC)
|
|---|
| 47 | .W !!,"DSS Department for Ward "_$P(ECXWARD,U,2)
|
|---|
| 48 | .W !?5,"Service ",?20,"<"_$E(ECXDEPT,1)_"> = "_$P(ECXDESC,U,1)
|
|---|
| 49 | .W !?5,"Prod. Unit ",?20,"<"_$E(ECXDEPT,2,3)_"> = "_$P(ECXDESC,U,2)
|
|---|
| 50 | .W !?5,"Division ",?20,"<"_$E(ECXDEPT,4)_"> = "_$P(ECXDESC,U,3)
|
|---|
| 51 | .W !?5,"Suffix ",?22," = "_$E(ECXDEPT,5,7),!!
|
|---|
| 52 | .S DIR(0)="YA",DIR("A")="Do you want edit this DSS Department? ",DIR("B")="YES" K X,Y
|
|---|
| 53 | .D ^DIR K DIR W !!
|
|---|
| 54 | .Q:$D(DIRUT)
|
|---|
| 55 | .I Y=1 D DEPT(ECXWARD,ECXDIV,.ECXDEPT)
|
|---|
| 56 | G:ECXDEPT0]"" EN
|
|---|
| 57 | ;if ward doesn't have dss dept, then enter
|
|---|
| 58 | I ECXDEPT0="" D DEPT(ECXWARD,ECXDIV,.ECXDEPT)
|
|---|
| 59 | G EN
|
|---|
| 60 | ;
|
|---|
| 61 | DEPT(ECXWARD,ECXDIV,ECXDEPT) ;allow user to enter/edit dss dept for ward
|
|---|
| 62 | ;division is already known from file #42 (above)
|
|---|
| 63 | ;service is 'nursing' by definition - ien 27 in file #730
|
|---|
| 64 | ; input
|
|---|
| 65 | ; ECXWARD = 1st piece is ien to file #42 & file #727.4; required
|
|---|
| 66 | ; ECXDIV = 1st piece is ien to file $40.8 & file #727.3; required
|
|---|
| 67 | ; output
|
|---|
| 68 | ; ECXDEPT = current dss department code for ward or null
|
|---|
| 69 | N ECXSVC,ECXPUNIT,ECXDESC,ECXSUF,OUT,X,Y,SS,JJ,DIRUT,DTOUT,DUOUT
|
|---|
| 70 | I ECXDEPT="" D
|
|---|
| 71 | .W !,"The medical center division for the ward selected is"
|
|---|
| 72 | .W !,"already known. The service associated with all ward"
|
|---|
| 73 | .W !,"production units is 'Nursing'.",!
|
|---|
| 74 | .W !!,"You must identify the DSS Production Unit for this ward,"
|
|---|
| 75 | .W !,"and a suffix (if needed) to complete the DSS Department code."
|
|---|
| 76 | .I $E(IOST)="C" D
|
|---|
| 77 | ..S SS=22-$Y F JJ=1:1:SS W !
|
|---|
| 78 | ..S DIR(0)="E" W ! D ^DIR K DIR W !
|
|---|
| 79 | I ECXDEPT]"" D
|
|---|
| 80 | .W !,"You may edit the DSS Production Unit and suffix,"
|
|---|
| 81 | F D Q:$D(DIRUT)!(OUT=1)
|
|---|
| 82 | .S ECXDEPT=""
|
|---|
| 83 | .S ECXSVC=27,(ECXPUNIT,ECXSUF)="",OUT=0
|
|---|
| 84 | .S ECXDEPT=$$DERIVE^ECXDSSD(ECXSVC,ECXPUNIT,+ECXDIV,ECXSUF)
|
|---|
| 85 | .;diplay dss dept code to user
|
|---|
| 86 | .I ECXDEPT="" S OUT=1 Q
|
|---|
| 87 | .D REVERSE^ECXDSSD(ECXDEPT,.ECXDESC)
|
|---|
| 88 | .W !!,"DSS Department for Ward "_$P(ECXWARD,U,2)
|
|---|
| 89 | .W !?5,"Service ",?20,"<"_$E(ECXDEPT,1)_"> = "_$P(ECXDESC,U,1)
|
|---|
| 90 | .W !?5,"Prod. Unit ",?20,"<"_$E(ECXDEPT,2,3)_"> = "_$P(ECXDESC,U,2)
|
|---|
| 91 | .W !?5,"Division ",?20,"<"_$E(ECXDEPT,4)_"> = "_$P(ECXDESC,U,3)
|
|---|
| 92 | .W !?5,"Suffix ",?22," = "_$E(ECXDEPT,5,7),!!
|
|---|
| 93 | .S DIR(0)="YA",DIR("A")="Is this ok? ",DIR("B")="YES" K X,Y
|
|---|
| 94 | .D ^DIR K DIR
|
|---|
| 95 | .I $D(DIRUT)!(Y=0) S ECXDEPT="" Q
|
|---|
| 96 | .I Y S OUT=1
|
|---|
| 97 | Q:$D(DIRUT)
|
|---|
| 98 | I ECXDEPT]"" S DIE="^ECX(727.4,",DA=+ECXWARD,DR="1////^S X=ECXDEPT;" D ^DIE
|
|---|
| 99 | W !!
|
|---|
| 100 | Q
|
|---|
| 101 | ;
|
|---|
| 102 | EXIT ;common exit point
|
|---|
| 103 | K ECX,ECXWARD,ECXDEPT,ECXSVC,ECXDIV,ECXPUNIT,ECXSUF,ECXDESC
|
|---|
| 104 | Q
|
|---|
