Changeset 636 for FOIAVistA/tag/r/SURGERY-SR/SROAPM.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• SURGERY-SR/SROAPM.m (modified) (6 diffs)

FOIAVistA/tag/r/SURGERY-SR/SROAPM.m

@@ -1 @@
-SROAPM ;BIR/ADM - PATIENT DEMOGRAPHIC INFO ;03/03/08
- ;;3.0; Surgery ;**47,81,111,107,100,125,142,160,166**;24 Jun 93;Build 6
+SROAPM ;BIR/ADM - PATIENT DEMOGRAPHIC INFO ;01/23/07
+ ;;3.0; Surgery ;**47,81,111,107,100,125,142,160**;24 Jun 93;Build 7
  I '$D(SRTN) W !!,"A Surgery Risk Assessment must be selected prior to using this option.",!!,"Press <RET> to continue  " R X:DTIME G END
  S SRSOUT=0,SRSUPCPT=1 D ^SROAUTL
@@ -40 +40 @@
  I '$G(VADM(12)) W ?40,"UNANSWERED"
  ;
- K DA,DIC,DIQ,DR,SRY S (DR,SRDR)="342;516;513",DIC="^SRF(",DA=SRTN,DIQ="SRY",DIQ(0)="E",DR=SRDR D EN^DIQ1 K DA,DIC,DIQ,DR
- S SRZ=12 F M=1:1 S I=$P(SRDR,";",M)  Q:'I  D
- .D TR,GET
- .S SRZ=SRZ+1,Y=$P(X,";;",2),SRFLD=$P(Y,"^"),(Z,SRZ(SRZ))=$P(Y,"^",2)_"^"_SRFLD,SREXT=SRY(130,SRTN,SRFLD,"E")
- .W !,$S($L(SRZ)<2:" "_SRZ,1:SRZ)_". "_$P(Z,"^")_":" D EXT
- ;S SRZ=15,SRZ(13)="Date of Death^342",SREXT=SRY(130,SRTN,342,"E") W !,"13. Date/Time of Death:",?40,SREXT
- ;S SRZ(14)="Surgery Consult Date^513",SREXT=SRY(130,SRTN,513,"E") W !,"14. Surgery Consult Date:",?40,SREXT
- ;S SRZ(15)="Date Surgery Consult Requested^516",SREXT=SRY(130,SRTN,516,"E") W !,"15. Date Surgery Consult Requested:",?40,SREXT
+ K DA,DIC,DIQ,DR,SRY S (DR,SRDR)="342",DIC="^SRF(",DA=SRTN,DIQ="SRY",DIQ(0)="E",DR=SRDR D EN^DIQ1 K DA,DIC,DIQ,DR
+ S SRZ=13,SRZ(13)="Date of Death^342",SREXT=SRY(130,SRTN,342,"E")
+ W !,"13. Date/Time of Death:",?40,SREXT
  K SROL,SROLINE,SRORC,SRORACE,SROLN,SROLN1,SROWRAP,SRNUM1
  ;
@@ -81 +76 @@
  .F I=0:1:38 S J=39-I,Y=$E(X,J) I Y=" " W ?40,$E(X,1,J-1) S X=$E(X,J+1,$L(X)) Q
  Q
-SEL W !!,"Select Patient Demographics Information to Edit: " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q
+SEL W !!,"Select number of item to edit: " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q
  I (X=11)!(X=12) S SRR=1 W !!,"The Patient's Race and Ethnicity information cannot be updated through the" D  Q
  .W !,"Surgery package options."
@@ -98 +93 @@
  Q
 HELP W @IOF,!!!!,"Enter the number or range of numbers you want to edit.  Examples of proper",!,"responses are listed below.",!!,"NOTE: Items 11 and 12 cannot be updated through the surgery package options."
- W !!,"1. Enter 'A' to update items 1 through 10 and items 13 through 15.",!!,"2. Enter a number (1-"_SRZ_") to update an individual item.  (For example,",!,"   enter '1' to update "_$P(SRZ(1),"^")_")"
+ W !!,"1. Enter 'A' to update items 1 through 10 and item 13.",!!,"2. Enter a number (1-"_SRZ_") to update an individual item.  (For example,",!,"   enter '1' to update "_$P(SRZ(1),"^")_")"
  W !!,"3. Enter a range of numbers (1-"_SRZ_") separated by a ':' to enter a range",!,"   of items.  (For example, enter '1:4' to update items 1, 2, 3 and 4.)",!
  I $D(SRFLG) W !,"4. Enter 'N' or 'NO' to enter negative response for all items.",!!,"5. Enter '@' to delete information from all items.",!
@@ -105 +100 @@
 RANGE ; range of numbers
  I $$LOCK^SROUTL(SRTN) D  D UNLOCK^SROUTL(SRTN)
- .S SHEMP=$P(X,":"),CURLEY=$P(X,":",2) D
- ..I SHEMP<13 F EMILY=SHEMP:1:10,13:1:15 Q:SRSOUT  D ONE
- ..I SHEMP>12 F EMILY=SHEMP:1:15 Q:SRSOUT  D ONE
+ .S SHEMP=$P(X,":"),CURLEY=$P(X,":",2) F EMILY=SHEMP:1:10,13 Q:SRSOUT  D ONE
  Q
 ONE ; edit one item
@@ -130 +123 @@
 DEC ;;453^Observation Discharge Date/Time
 DED ;;454^Observation Treating Specialty
-EAC ;;513^Surgery Consult Date
-EAF ;;516^Date Surgery Consult Requested