| 1 | SROAMAN ;BIR/ADM-Managerial Site ID and Assessment Data Input; [ 04/26/97 2:55 PM ]
|
|---|
| 2 | ;;3.0; Surgery ;**38,39,55,61,67**;24 Jun 93
|
|---|
| 3 | MAN() ; determine if site is a risk assessment managerial site
|
|---|
| 4 | N MAN,SITE,Y S MAN=0,SITE=+$P($$SITE^SROVAR,"^",3)
|
|---|
| 5 | S Y="436,442,503,505,517,519,556,557,564,568,569,574,579,585,591,595,609,612,613,617,619,622,623,647,655,659,668,677,680,686,687"
|
|---|
| 6 | S:Y[SITE MAN=1 K SITE,Y
|
|---|
| 7 | Q MAN
|
|---|
| 8 | PRE S (SRFLG,SRCC)=1,SRR=0,SRPROMPT="Preoperative Information" D HDR^SROAUTL,OUT1^SROAUTL0,SEL Q:SRSOUT G:SRR PRE
|
|---|
| 9 | I $D(SRCC) D CONCC
|
|---|
| 10 | Q
|
|---|
| 11 | LAB S SRCC=1,SRR=0,SRPROMPT="Preoperative Laboratory Information" D HDR^SROAUTL,LAB^SROAUTL0,SEL Q:SRSOUT G:SRR LAB
|
|---|
| 12 | I $D(SRCC) D CONCC
|
|---|
| 13 | Q
|
|---|
| 14 | SEL W !!,"Select "_SRPROMPT_" to edit: " R X:DTIME I '$T!(X["^") D:$D(SRCC) CONCC S SRSOUT=1 Q
|
|---|
| 15 | Q:X="" S:X="a" X="A" I '$D(SRFLG),'$D(SRX(X)),(X'?1.2N1":"1.2N),X'="A" D HELP S SRR=1 Q
|
|---|
| 16 | I $D(SRFLG),'$D(SRX(X)),(X'?1.2N1":"1.2N),X'="A",X'="N",X'="NO",X'="@" D HELP S SRR=1 Q
|
|---|
| 17 | I X?1.2N1":"1.2N S Y=$P(X,":"),Z=$P(X,":",2) I Y<1!(Z>SRX)!(Y>Z) D HELP S SRR=1 Q
|
|---|
| 18 | I $D(SRFLG),(X="N"!(X="NO")) D NO S SRR=1 Q
|
|---|
| 19 | I $D(SRFLG),X="@" D DEL S SRR=1 Q
|
|---|
| 20 | S MM=$E(X) I $D(SRCC)!('$D(SRCC)&((MM'=4)!(MM'=5))) D HDR^SROAUTL
|
|---|
| 21 | I X="A" S X="1:"_SRX
|
|---|
| 22 | I X?1.2N1":"1.2N D RANGE S SRR=1 Q
|
|---|
| 23 | I $D(SRX(X)),+X=X S EMILY=X D ONE S SRR=1
|
|---|
| 24 | Q
|
|---|
| 25 | OERR S SROERR=SRTN D ^SROERR0
|
|---|
| 26 | Q
|
|---|
| 27 | HELP W @IOF,!!!!,"Enter the number, number/letter combination, or range of numbers you",!,"want to edit. Examples of proper responses are listed below."
|
|---|
| 28 | W !!,"1. Enter 'A' to update all items.",!!,"2. Enter a number (1-"_SRX_") to update an individual item. (For example,",!," enter '1' to update "_$P(SRX(1),"^")_")"
|
|---|
| 29 | W !!,"3. Enter a range of numbers (1-"_SRX_") separated by a ':' to enter a range",!," of items. (For example, enter '1:4' to update items 1, 2, 3 and 4.)",!
|
|---|
| 30 | I $D(SRFLG) W !,"4. Enter 'N' or 'NO' to enter negative response for all items.",!!,"5. Enter '@' to delete information from all items.",!
|
|---|
| 31 | D PRESS
|
|---|
| 32 | Q
|
|---|
| 33 | RANGE ; range of numbers
|
|---|
| 34 | S SHEMP=$P(X,":"),CURLEY=$P(X,":",2) F EMILY=SHEMP:1:CURLEY Q:SRSOUT D ONE
|
|---|
| 35 | Q
|
|---|
| 36 | ONE ; edit one item
|
|---|
| 37 | K DR,DA,DIE S DR=$P(SRX(EMILY),"^",2)_"T",DA=SRTN,DIE=130,SRDT=$P(SRX(EMILY),"^",3) S:SRDT DR=DR_";"_SRDT_"T" D ^DIE K DR,DA I $D(Y) S SRSOUT=1
|
|---|
| 38 | Q
|
|---|
| 39 | PRESS W ! K DIR S DIR("A")="Press the return key to continue or '^' to exit: ",DIR(0)="FOA" D ^DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1
|
|---|
| 40 | Q
|
|---|
| 41 | CONCC ; check for concurrent case and update if one exists
|
|---|
| 42 | S SRCON=$P($G(^SRF(SRTN,"CON")),"^") Q:'SRCON
|
|---|
| 43 | Q:$P($G(^SRF(SRCON,"RA")),"^",2)="C"
|
|---|
| 44 | K DA,DIC,DIQ,DR,SRY S DA=SRTN,DR=SRDR,DIC="^SRF(",DIQ="SRY",DIQ(0)="I" D EN^DIQ1
|
|---|
| 45 | S SRI="" F S SRI=$O(SRY(130,SRTN,SRI)) Q:'SRI S SRW=SRY(130,SRTN,SRI,"I") S:SRW="" SRW="@" K DA,DIE,DR S DA=SRCON,DIE=130,DR=SRI_"////"_SRW D ^DIE
|
|---|
| 46 | Q
|
|---|
| 47 | NO ; stuff negative responses for all items
|
|---|
| 48 | K DA,DIE,DR S DR="" F SRI=1:1 S SRFLD=$P(SRDR,";",SRI) Q:'SRFLD S DR=DR_SRFLD_"////"_$S(SRFLD=240:1,SRFLD=325:1,SRFLD=413:1,1:"N")_";"
|
|---|
| 49 | S DA=SRTN,DIE=130 D ^DIE K DA,DIE,DR
|
|---|
| 50 | Q
|
|---|
| 51 | DEL ; delete information for all items
|
|---|
| 52 | W !,*7 K DIR S DIR("A")=" Are you sure you want to delete all information ",DIR(0)="Y" D ^DIR K DIR I 'Y!$D(DTOUT)!$D(DUOUT) Q
|
|---|
| 53 | K DA,DIE,DR S DR="" F SRI=1:1 S SRFLD=$P(SRDR,";",SRI) Q:'SRFLD S DR=DR_SRFLD_"////@;"
|
|---|
| 54 | S DA=SRTN,DIE=130 D ^DIE K DA,DIE,DR
|
|---|
| 55 | Q
|
|---|
