SROCMPL.m

SROCMPL ;B'HAM ISC/MAM - ENTER NON-OPERATIVE OCCURRENCES; [ 01/08/98   9:54 AM ]

 ;;3.0; Surgery ;**38,77**;24 Jun 93

 W @IOF,!,"NOTE:  You are about to enter an occurrence for a patient that has not had an",!,"operation during this admission.  If this patient has a surgical procedure"

 W !,"during the current admission, use the option to enter or edit intraoperative",!,"and postoperative occurrences.",!!

 W !! K Y,DIC S DIC=2,DIC(0)="QEAM" D ^DIC G:Y<0 END S DFN=+Y,SRNM=$P(Y,"^",2)

 W @IOF,!,?3,SRNM,!

 S (SROP,CNT)=0 F I=0:0 S SROP=$O(^SRF("ANON",DFN,SROP)) Q:'SROP  S CNT=CNT+1,SRSDATE=$P(^SRF(SROP,0),"^",9) D LIST

 S CNT=CNT+1,SRCASE(CNT)="" W !!,CNT_".",?14,"ENTER A NEW NON-OPERATIVE OCCURRENCE"

OPT R !!!!,"Select Number:  ",OPT:DTIME I '$T!("^"[OPT) K SRTN G END

 I OPT["?"!('$D(SRCASE(OPT))) W !!,"Enter the number of the desired occurrence, or '"_CNT_"' to enter a new occurrence." G OPT

 G:OPT=CNT NEW

ENTER S SRTN=SRCASE(OPT) R !!!,"Enter or Delete Data ?  E// ",Z:DTIME G:'$T!(Z="^") END S Z=$E(Z) S:Z="" Z="E"

 I "ED"'[Z D HELP G ENTER

 I "Dd"[Z D ^SROCMPD G END

 S SRSDATE=$P(^SRF(SRTN,0),"^",9) W @IOF D COMP

 G END

LIST ; list case

 W !,CNT_". "_$E(SRSDATE,4,5)_"-"_$E(SRSDATE,6,7)_"-"_$E(SRSDATE,2,3),?14,"OCCURRENCE IN WHICH THERE WAS NO SURGICAL PROCEDURE",!,?14,"DURING THE CURRENT ADMISSION" S SRCASE(CNT)=SROP

 Q

HELP ; help text

 W !!,"Enter RETURN to select an option used to enter or edit information for this",!,"case.  If you would like a two screen overview of this operation, enter"

 W !,"'Review'.  To delete this surgical case from your records, Enter 'Delete'.",!,"Please note that choosing to delete a case will remove EVERYTHING pertaining",!,"to this operative procedure.",!

 Q

KEY S NOKEY=0 I '$D(^XUSEC("SROEDIT",DUZ)) S NOKEY=1 W !!,"You do not have the access necessary to delete a case from the file.",!!,"Press RETURN to continue  " R X:DTIME Q

 Q

END W @IOF D ^SRSKILL K SRTN

 Q

PROMPT ;

 D KEY Q:NOKEY  W !!,"By deleting this case, all information stored for this operative procedure",!,"will be removed from the computer."

 Q

NEW ; enter new occurrence

 W @IOF,! S %DT("A")="Select the Date of Occurrence: ",%DT="AEXP" D ^%DT I Y<0 W !!,"When entering a new non-operative occurrence, a date MUST be entered.",!! G SROCMPL

 G:Y'>0 END S SRSDATE=Y

 S SRPRIN="OCCURRENCE IN WHICH THERE WAS NO SURGICAL PROCEDURE DURING THE CURRENT ADMISSION"

 K DA,DIC,DO,DD,DINUM,SRTN S X=DFN,DIC="^SRF(",DIC(0)="L",DLAYGO=130 D FILE^DICN K DIC,DLAYGO S SRTN=+Y

 K DIE,DR S DA=SRTN,DIE=130,DR=".09///"_SRSDATE_";26///"_SRPRIN D ^DIE K DR S ^SRF(SRTN,37)=1

COMP ; enter occurrence information

 K DIE,DR S DR="[SROCOMP]",DIE=130,DA=SRTN D ^DIE K DR W !!,"Press RETURN to continue  " R X:DTIME

 D END

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SROCMPL   2773     printed  Mar 13, 2025@21:48:01                                                                                                                                                                                                     Page 2

SROCMPL   ;B'HAM ISC/MAM - ENTER NON-OPERATIVE OCCURRENCES; [ 01/08/98   9:54 AM ]

 +1       ;;3.0; Surgery ;**38,77**;24 Jun 93

 +2        WRITE @IOF,!,"NOTE:  You are about to enter an occurrence for a patient that has not had an",!,"operation during this admission.  If this patient has a surgical procedure"

 +3        WRITE !,"during the current admission, use the option to enter or edit intraoperative",!,"and postoperative occurrences.",!!

 +4        WRITE !!

           KILL Y,DIC

           SET DIC=2

           SET DIC(0)="QEAM"

           DO ^DIC

           if Y<0

               GOTO END

           SET DFN=+Y

           SET SRNM=$PIECE(Y,"^",2)

 +5        WRITE @IOF,!,?3,SRNM,!

 +6        SET (SROP,CNT)=0

           FOR I=0:0

               SET SROP=$ORDER(^SRF("ANON",DFN,SROP))

               if 'SROP

                   QUIT 

               SET CNT=CNT+1

               SET SRSDATE=$PIECE(^SRF(SROP,0),"^",9)

               DO LIST

 +7        SET CNT=CNT+1

           SET SRCASE(CNT)=""

           WRITE !!,CNT_".",?14,"ENTER A NEW NON-OPERATIVE OCCURRENCE"

OPT        READ !!!!,"Select Number:  ",OPT:DTIME

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

               KILL SRTN

               GOTO END

 +1        IF OPT["?"!('$DATA(SRCASE(OPT)))

               WRITE !!,"Enter the number of the desired occurrence, or '"_CNT_"' to enter a new occurrence."

               GOTO OPT

 +2        if OPT=CNT

               GOTO NEW

ENTER      SET SRTN=SRCASE(OPT)

           READ !!!,"Enter or Delete Data ?  E// ",Z:DTIME

           if '$TEST!(Z="^")

               GOTO END

           SET Z=$EXTRACT(Z)

           if Z=""

               SET Z="E"

 +1        IF "ED"'[Z

               DO HELP

               GOTO ENTER

 +2        IF "Dd"[Z

               DO ^SROCMPD

               GOTO END

 +3        SET SRSDATE=$PIECE(^SRF(SRTN,0),"^",9)

           WRITE @IOF

           DO COMP

 +4        GOTO END

LIST      ; list case

 +1        WRITE !,CNT_". "_$EXTRACT(SRSDATE,4,5)_"-"_$EXTRACT(SRSDATE,6,7)_"-"_$EXTRACT(SRSDATE,2,3),?14,"OCCURRENCE IN WHICH THERE WAS NO SURGICAL PROCEDURE",!,?14,"DURING THE CURRENT ADMISSION"

           SET SRCASE(CNT)=SROP

 +2        QUIT 

HELP      ; help text

 +1        WRITE !!,"Enter RETURN to select an option used to enter or edit information for this",!,"case.  If you would like a two screen overview of this operation, enter"

 +2        WRITE !,"'Review'.  To delete this surgical case from your records, Enter 'Delete'.",!,"Please note that choosing to delete a case will remove EVERYTHING pertaining",!,"to this operative procedure.",!

 +3        QUIT 

KEY        SET NOKEY=0

           IF '$DATA(^XUSEC("SROEDIT",DUZ))

               SET NOKEY=1

               WRITE !!,"You do not have the access necessary to delete a case from the file.",!!,"Press RETURN to continue  "

               READ X:DTIME

               QUIT 

 +1        QUIT 

END        WRITE @IOF

           DO ^SRSKILL

           KILL SRTN

 +1        QUIT 

PROMPT    ;

 +1        DO KEY

           if NOKEY

               QUIT 

           WRITE !!,"By deleting this case, all information stored for this operative procedure",!,"will be removed from the computer."

 +2        QUIT 

NEW       ; enter new occurrence

 +1        WRITE @IOF,!

           SET %DT("A")="Select the Date of Occurrence: "

           SET %DT="AEXP"

           DO ^%DT

           IF Y<0

               WRITE !!,"When entering a new non-operative occurrence, a date MUST be entered.",!!

               GOTO SROCMPL

 +2        if Y'>0

               GOTO END

           SET SRSDATE=Y

 +3        SET SRPRIN="OCCURRENCE IN WHICH THERE WAS NO SURGICAL PROCEDURE DURING THE CURRENT ADMISSION"

 +4        KILL DA,DIC,DO,DD,DINUM,SRTN

           SET X=DFN

           SET DIC="^SRF("

           SET DIC(0)="L"

           SET DLAYGO=130

           DO FILE^DICN

           KILL DIC,DLAYGO

           SET SRTN=+Y

 +5        KILL DIE,DR

           SET DA=SRTN

           SET DIE=130

           SET DR=".09///"_SRSDATE_";26///"_SRPRIN

           DO ^DIE

           KILL DR

           SET ^SRF(SRTN,37)=1

COMP      ; enter occurrence information

 +1        KILL DIE,DR

           SET DR="[SROCOMP]"

           SET DIE=130

           SET DA=SRTN

           DO ^DIE

           KILL DR

           WRITE !!,"Press RETURN to continue  "

           READ X:DTIME

 +2        DO END

 +3        QUIT