| [613] | 1 | NURACE7 ;HIRMFO/MD-RM-PATIENT CLASSIFICATION DRIVER-cont. ;6/6/96
|
|---|
| 2 | ;;4.0;NURSING SERVICE;**7**;Apr 25, 1997
|
|---|
| 3 | EN1 ; SET LOCAL VARIABLES WITH PATIENT DATA
|
|---|
| 4 | I NURSBS=11 S CONFIGX="USER",(FACTX,FACTORS)="N/A",COMMENTX=""
|
|---|
| 5 | G:CLASSREV=0 PRINTIT
|
|---|
| 6 | I NURSCLAS'>0 W !,$C(7)," NO PREVIOUS CLASSIFICATION--CANNOT REVIEW " Q
|
|---|
| 7 | S NURSOLDC=NURSCLAS
|
|---|
| 8 | S NURSREV=$O(^NURSA(214.7,"AA",DFN,NURSCLAS,"")) G:NURSREV="" A2
|
|---|
| 9 | S NURSREV=$O(^NURSA(214.7,"AA",DFN,NURSCLAS,NURSREV,"")) G:(NURSREV="")!(NURSREV=0) A2
|
|---|
| 10 | A1 S NRX=^NURSA(214.7,NURSREV,0),REVDATE=$P(NRX,"^",1),REVNO=$P(NRX,"^",6),REVIEWER=$S(REVNO="":"",'$D(^VA(200,REVNO,0)):"",1:$P(^(0),"^",1)) G PRINTIT
|
|---|
| 11 | A2 S (REVNO,REVIEWER,REVDATE)=""
|
|---|
| 12 | PRINTIT ;GO TO CLASSIFY PATIENT
|
|---|
| 13 | S OUTSW=0 D EN1^NURACE1 I OUTSW L -^NURSF(214,DFN) Q
|
|---|
| 14 | G FINAL21:NOREVSW,FINAL2:NURSRTSW
|
|---|
| 15 | I CONFIGX="COMPUTER" S COMMENTX="" G FINAL2
|
|---|
| 16 | I NURSBS=11 S COMMENTX="",CONFIGX="USER" G FINAL2
|
|---|
| 17 | COMADD ;ENTER COMMENTS IF NECESSARY
|
|---|
| 18 | W !!,"Enter Comments: " W:(COMMENTX'="") COMMENTX,!,"//" R X:DTIME S:X=""&$T X=COMMENTX
|
|---|
| 19 | I (X="^")!('$T) D EN4^NURACE8 L -^NURSF(214,DFN) S OUTSW=1 Q
|
|---|
| 20 | I $L(X)>50!(X["?") W !,$C(7),"ANSWER MUST BE 1 TO 50 CHARACTERS IN LENGTH:" G COMADD
|
|---|
| 21 | F I=1:1:$L(X) Q:$E(X,1)'=" " S X=$E(X,2,$L(X))
|
|---|
| 22 | I X="" W !,$C(7),"*** WHEN CHANGING THE CLASSIFICATION, COMMENTS MUST BE FILLED IN ***" G COMADD
|
|---|
| 23 | I X=COMMENTX G FINAL2
|
|---|
| 24 | I X="@" W $C(7)," *** COMMENTS CANNOT BE DELETED ***" G COMADD
|
|---|
| 25 | I X'?1A.ANP!(X["^") W !,"ANSWER MUST BE 1 TO 50 CHARACTERS IN LENGTH" G COMADD
|
|---|
| 26 | S CHANGESW=1,COMMENTX=X
|
|---|
| 27 | FINAL2 ;ADD PATIENT CLASSIFICATION TO DATABASE
|
|---|
| 28 | W !!
|
|---|
| 29 | L -^NURSF(214,DFN) S CONFIGX=$E(CONFIGX,1)
|
|---|
| 30 | S X="N",%DT="T" D ^%DT S DATEX=Y S:$E(DATEX,8)'="." DATEX=$E(DATEX,1,7)_".00001"
|
|---|
| 31 | CHK I $$DUPCLAS^NURSCUTL(DATEX,DFN) S DATEX=(DATEX+.000001) G CHK
|
|---|
| 32 | S DA=$P(^NURSA(214.6,0),U,3)
|
|---|
| 33 | LOCK S DA=DA+1 L +^NURSA(214.6,DA,0):0 I '$T!$D(^NURSA(214.6,DA)) L -^NURSA(214.6,DA,0) G LOCK
|
|---|
| 34 | S ^NURSA(214.6,DA,0)=DATEX_"^"_DFN_"^"_CLASSX_"^"_FACTORS_"^"_CONFIGX_"^"_DUZ_"^"_COMMENTX_"^"_NURSWARD_"^"_NURSBS_"^^"_NURSRMBD S X=^NURSA(214.6,DA,0)
|
|---|
| 35 | S ^NURSA(214.6,"AA",$P(X,"^",2),9999999-$P(X,"^",1),DA)=""
|
|---|
| 36 | S ^NURSA(214.6,"B",$E($P(X,"^",1),1,30),DA)=""
|
|---|
| 37 | S ^NURSA(214.6,"C",$E($P(X,"^",2),1,30),DA)=""
|
|---|
| 38 | S ^NURSA(214.6,"E",$E($P(X,"^",8),1,30),DA)=""
|
|---|
| 39 | S $P(^NURSA(214.6,0),U,3,4)=DA_"^"_($P(^NURSA(214.6,0),"^",4)+1) L -^NURSA(214.6,DA,0)
|
|---|
| 40 | S NEWREV=DA
|
|---|
| 41 | FINAL21 ;
|
|---|
| 42 | I CLASSREV=1 D ADDREV
|
|---|
| 43 | Q
|
|---|
| 44 | ADDREV ; ADD REVIEWED CLASSIFICATION DATA
|
|---|
| 45 | S NOREVSW=$S('NOREVSW:"Y",1:"N")
|
|---|
| 46 | S DA=$P(^NURSA(214.7,0),"^",3)
|
|---|
| 47 | LOCK1 S DA=DA+1 L +^NURSA(214.7,DA,0):0 I '$T!$D(^NURSA(214.7,DA)) L -^NURSA(214.7,DA,0) G LOCK1
|
|---|
| 48 | S X="N",%DT="T" D ^%DT S NURSRVDT=Y S:'$D(NEWREV) NEWREV=""
|
|---|
| 49 | S ^NURSA(214.7,DA,0)=NURSRVDT_"^"_DFN_"^"_NURSOLDC_"^"_NOREVSW_"^"_NEWREV_"^"_DUZ S X=^NURSA(214.7,DA,0)
|
|---|
| 50 | S ^NURSA(214.7,"AA",$P(X,"^",2),$P(X,"^",3),9999999-$P(X,"^",1),DA)=""
|
|---|
| 51 | S ^NURSA(214.7,"B",$E($P(X,"^",1),1,30),DA)=""
|
|---|
| 52 | S ^NURSA(214.7,"C",$E($P(X,"^",2),1,30),DA)=""
|
|---|
| 53 | S ^NURSA(214.7,0)=$P(^NURSA(214.7,0),"^",1,2)_"^"_DA_"^"_($P(^NURSA(214.7,0),"^",4)+1) L -^NURSA(214.7,DA,0)
|
|---|
| 54 | Q
|
|---|
