Routine: SRENSCS

SRENSCS ;BIR/SJA - ENSURING CORRECT SURGERY ;04/26/04

 ;;3.0; Surgery ;**129,153**;24 Jun 93;Build 11

 ; entry point called by 'AIN' x-ref of the correct surgery fields

IN I X'="N"!(X'=Y) Q

 N SRJ,SRK,SRTN1,SRYN S SRTN1=$S($D(SRTN):SRTN,1:DA) Q:'SRTN1

 S SRJ=$S(+DI=71:"3;82",+DI=72:"4;83",1:"5;84")

ASK D EN^DDIOL("Correct Surgery Comments should be entered when a ""NO"" response is entered.",,"!!")

 D FIELD^DID("130.0"_$P(SRJ,";",2),.01,"","TITLE","SRK")

 D EN^DDIOL("Do you want to enter "_SRK("TITLE")_" ?  YES// ",,"!")

 R SRYN:DTIME I '$T!(SRYN["^") Q

 S SRYN=$E(SRYN) S:SRYN="" SRYN="Y" I SRYN["?" D HELP G ASK

 I "YyNn"'[SRYN D EN^DDIOL("Enter 'YES' to enter correct surgery comments now, 'NO' to quit, or '?' for more help.",,"!!") G ASK

 I "Nn"[SRYN Q

 ; edit the associated comments fields

 N DR,DIE,DA,DP,DC,DL,DE,DI,DIEL,DIETMP,DIFLD,DIP,DK,DM,DP,DQ,DU,DV,DW

 W ! S DIE=130,DA=SRTN1,DR=$P(SRJ,";",2)_"T" D ^DIE

HELP D EN^DDIOL("Enter 'YES' to enter correct surgery comments.  Enter 'NO' to quit without entering correct surgery comments.",,"!!")

HR ;entry point called by 'AN' x-ref of the Sur Site Hair Removal Method field

 I X'="S"&(X'="O") Q

 N SRTN1,SRYN,SRSEL S SRSEL=X,SRTN1=$S($D(SRTN):SRTN,1:DA) Q:'SRTN1

HRASK I SRSEL="O" D  G HRC

 .D EN^DDIOL("Because OTHER has been selected, information must be entered into the comments",,"!!")

 .D EN^DDIOL("field explaining the other technique.",,"!")

SH D EN^DDIOL("It has been determined that shaving the surgical site results in a greater",,"!!")

 D EN^DDIOL("likelihood of infection. Current best practices suggest that clippers should",,"!")

 D EN^DDIOL("be used instead of shaving. Whenever hair is removed by shaving, a comment must",,"!")

 D EN^DDIOL("be entered explaining why this process was used instead of safer techniques.",,"!")

HRC ; edit the associated comments fields

 N DR,DIE,DA,DP,DC,DL,DE,DI,DIEL,DIETMP,DIFLD,DIP,DK,DM,DP,DQ,DU,DV,DW

 W ! S DIE=130,DA=SRTN1,DR=508_"T" D ^DIE

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRENSCS   2009     printed  Apr 09, 2024@21:41:38                                                                                                                                                                                                     Page 2

SRENSCS   ;BIR/SJA - ENSURING CORRECT SURGERY ;04/26/04

 +1       ;;3.0; Surgery ;**129,153**;24 Jun 93;Build 11

 +2       ;

 +3       ; entry point called by 'AIN' x-ref of the correct surgery fields

IN         IF X'="N"!(X'=Y)

               QUIT

 +1        NEW SRJ,SRK,SRTN1,SRYN

           SET SRTN1=$SELECT($DATA(SRTN):SRTN,1:DA)

           if 'SRTN1

               QUIT

 +2        SET SRJ=$SELECT(+DI=71:"3;82",+DI=72:"4;83",1:"5;84")

ASK        DO EN^DDIOL("Correct Surgery Comments should be entered when a ""NO"" response is entered.",,"!!")

 +1        DO FIELD^DID("130.0"_$PIECE(SRJ,";",2),.01,"","TITLE","SRK")

 +2        DO EN^DDIOL("Do you want to enter "_SRK("TITLE")_" ?  YES// ",,"!")

 +3        READ SRYN:DTIME

           IF '$TEST!(SRYN["^")

               QUIT

 +4        SET SRYN=$EXTRACT(SRYN)

           if SRYN=""

               SET SRYN="Y"

           IF SRYN["?"

               DO HELP

               GOTO ASK

 +5        IF "YyNn"'[SRYN

               DO EN^DDIOL("Enter 'YES' to enter correct surgery comments now, 'NO' to quit, or '?' for more help.",,"!!")

               GOTO ASK

 +6        IF "Nn"[SRYN

               QUIT

 +7       ; edit the associated comments fields

 +8        NEW DR,DIE,DA,DP,DC,DL,DE,DI,DIEL,DIETMP,DIFLD,DIP,DK,DM,DP,DQ,DU,DV,DW

 +9        WRITE !

           SET DIE=130

           SET DA=SRTN1

           SET DR=$PIECE(SRJ,";",2)_"T"

           DO ^DIE

 +10       QUIT

HELP       DO EN^DDIOL("Enter 'YES' to enter correct surgery comments.  Enter 'NO' to quit without entering correct surgery comments.",,"!!")

 +1        QUIT

HR        ;entry point called by 'AN' x-ref of the Sur Site Hair Removal Method field

 +1        IF X'="S"&(X'="O")

               QUIT

 +2        NEW SRTN1,SRYN,SRSEL

           SET SRSEL=X

           SET SRTN1=$SELECT($DATA(SRTN):SRTN,1:DA)

           if 'SRTN1

               QUIT

HRASK      IF SRSEL="O"

               Begin DoDot:1

 +1                DO EN^DDIOL("Because OTHER has been selected, information must be entered into the comments",,"!!")

 +2                DO EN^DDIOL("field explaining the other technique.",,"!")

               End DoDot:1

               GOTO HRC

SH         DO EN^DDIOL("It has been determined that shaving the surgical site results in a greater",,"!!")

 +1        DO EN^DDIOL("likelihood of infection. Current best practices suggest that clippers should",,"!")

 +2        DO EN^DDIOL("be used instead of shaving. Whenever hair is removed by shaving, a comment must",,"!")

 +3        DO EN^DDIOL("be entered explaining why this process was used instead of safer techniques.",,"!")

HRC       ; edit the associated comments fields

 +1        NEW DR,DIE,DA,DP,DC,DL,DE,DI,DIEL,DIETMP,DIFLD,DIP,DK,DM,DP,DQ,DU,DV,DW

 +2        WRITE !

           SET DIE=130

           SET DA=SRTN1

           SET DR=508_"T"

           DO ^DIE

 +3        QUIT

SRENSCS.m