source: FOIAVistA/tag/r/SURGERY-SR/SROVAR.m@ 1424

Last change on this file since 1424 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 5.9 KB
Line 
1SROVAR ;BIR/MAM,ADM - SITE PARAMETERS ;10/04/05
2 ;;3.0; Surgery ;**17,38,48,67,77,50,87,88,102,107,100,134,144,157**;24 Jun 93;Build 3
3 ;
4 ; Reference to ^TMP("CSLSUR1" supported by DBIA #3498
5 ;
6 K ^TMP("CSLSUR1",$J),^TMP("SRPFSS",$J) D CLEAR
7 I $D(SRSITE) Q
8 D CPT
9 K SRL S (SRCNT,X)=0 F S X=$O(^SRO(133,X)) Q:'X I '$P($G(^SRO(133,X,0)),"^",21) S SRCNT=SRCNT+1,SRL(SRCNT)=X
10 I SRCNT=1 S SRSITE=SRL(1) G SET
11 K XQUIT,DIR W ! I SRCNT>1 S DIR("?",1)=" Because there is more than one division in the SURGERY SITE PARAMETERS",DIR("?")=" file, a division must be selected."
12 S DIR(0)="P^133:EM",DIR("A")="Select Division",DIR("S")="I '$P(^SRO(133,+Y,0),U,21)" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) D ^SRSKILL S XQUIT="" Q
13 S SRSITE=+Y
14SET ; set site parameters
15 S S(0)=^SRO(133,SRSITE,0),SRSITE("AML")=$P(S(0),"^",4),SRSITE("REQ")=$P(S(0),"^",2) K:SRSITE("REQ")="" SRSITE("REQ")
16 S SRSITE("IV")=$P(S(0),"^",7) K:SRSITE("IV")="" SRSITE("IV")
17 S SRSITE("DIV")=$P(S(0),"^"),SRSITE("SITE")=$$GET1^DIQ(4,SRSITE("DIV"),.01)
18 S SRSITE("NRPT")=$P(S(0),"^",6) I SRSITE("NRPT")="" S SRSITE("NRPT")=1
19 I '$D(SRSITE("OPTION")),$D(XQY) S SRSITE("OPTION")=XQY
20 K S
21 Q
22CPT ; display CPT copyright notice
23 N SRCPT,SRDIV S (SRCPT,SRDIV)=0 F S SRDIV=$O(^SRO(133,SRDIV)) Q:'SRDIV I $D(^SRO(133,SRDIV,6,DT,1,DUZ)) S SRCPT=1 Q
24 Q:SRCPT D COPY^ICPTAPIU I $G(IOST)'["P-" W ! K DIR S DIR("A")="Press the 'Return' key to continue",DIR(0)="FOA" D ^DIR K DIR
25 K DD,DO,DA,DIC S SRDIV=$O(^SRO(133,0))
26 I '$D(^SRO(133,SRDIV,6,DT,0)) S X=DT,DA(1)=SRDIV,DIC="^SRO(133,SRDIV,6,",DIC("P")=$P(^DD(133,36,0),"^",2),DIC(0)="L",DINUM=X D FILE^DICN K DD,DO,DA,DIC I Y=-1 Q
27 S X=DUZ,DA(2)=SRDIV,DA(1)=DT,DIC="^SRO(133,SRDIV,6,DT,1,",DIC("P")=$P(^DD(133.036,1,0),"^",2),DIC(0)="L",DINUM=X D FILE^DICN K DA,DD,DIC,DO
28 Q
29EN2 ; set view only and titles for screens
30 I '$D(^XUSEC("SROEDIT",DUZ)) S Q3("VIEW")=""
31 Q:'$D(SRTN) Q:SRTN<1 S:'$D(ST) ST="SCHEDULING" S DFN=$P(^SRF(SRTN,0),"^") D DEM^VADPT S SRN=$E(VADM(1),1,20),Q3(1)="** "_ST_" ** CASE #"_SRTN_" "_SRN_" "
32 Q
33DEV S SRION=$S($D(ION):ION,1:"HOME") K %ZIS S %ZIS="QN",IOP=X D ^%ZIS I POP S IOP=SRION D ^%ZIS K %ZIS,IOP,SRION,X Q
34 W $S(X=$E(ION,1,$L(X)):$E(ION,$L(X)+1,$L(ION)),1:" "_ION) S X=ION D ^%ZISC K %ZIS,SRION,IOP Q
35 Q
36TIME ; transform time to date of operation at that time
37 I $D(SRSMED) S DA=SRTN
38 S:$D(SRTN) SRTDA=DA,DA=SRTN S X=$S(X?1.4N.A!(X?1.2N1":"2N.A):Z_"@"_X,1:X)
39 S %DT="EPTXR" D ^%DT S X=Y G:'$D(^SRF(DA,.2)) RESET I X>0 S SRSTART=$P(^SRF($S($D(SRTN):SRTN,1:DA),.2),"^",15) I SRSTART'="" D BEFORE
40 S:$D(SRTDA) DA=SRTDA Q
41BEFORE W:X<SRSTART !!,"The time entered is before the 'TIME PAT IN HOLD AREA'. Please check the",!,"DATE/TIME entered for this field." H 2
42 Q
43RESET S:$D(SRTDA) DA=SRTDA Q
44INPUT ; input transfor for ASA CLASS
45 S:'$D(DA) DA=SRTN S SRFLD=1.13 I $D(^SRF(DA,"CON")),$P(^("CON"),"^") D ^SROCON Q
46 Q
47PARAM ; enter/edit site parameters
48 W @IOF K DIC,DINUM S DIC=133,DIC(0)="QEAMZL",DLAYGO=133,DIC("A")="Edit Parameters for which Surgery Site: " D ^DIC K DIC I Y<0 W @IOF Q
49 N SRDIV,SRN,SRNAME,SRNUM S SRDIV=+Y,SRN=+Y(0),SRNAME=Y(0,0),SRNUM=$$GET1^DIQ(4,SRN,99),Q3(1)=" "_SRNAME_" ("_SRNUM_") "
50 K DIE,DR,DA,Y S DA=SRDIV,DR="[SRPARAM]",DIE=133 D ^SRCUSS K DR,DIE,DA,ST W @IOF I $D(SRSITE) D SET
51 Q
52EXIT ; exit action for all Surgery options
53 I $D(XQY),$G(SRSITE("OPTION"))=XQY K SRSITE,SRTN,^TMP("SRCUSS",$J)
54 D CLEAR
55 Q
56SITE() ; extrinsic call to output Institution file pointer (from Default Institution field in file 4.3)^Institution name^Station number
57 N SITE,SRI,SRX,SRY
58 S SITE=$$KSP^XUPARAM("INST") I 'SITE Q SITE
59 S SRX=SITE F SRI=.01,99 S SRY=$$GET1^DIQ(4,SRX,SRI),SITE=SITE_"^"_SRY
60 Q SITE
61OFF1 ; compare time off with time on
62 S Z=$E($P(^SRF($S($D(SRTN):SRTN,1:DA(1)),0),"^",9),1,7),X=$S(X?1.4N.A!(X?1.2N1":"2N.A):Z_"@"_X,1:X) K %DT,Z S %DT="PTXR" D ^%DT S X=Y I Y<1 D OUT Q
63 S SRSTART=$P(^SRF(DA(1),SRSUB,DA,0),"^",SRP) D COMP
64 Q
65OFF2 ; compare time off with time on
66 S Z=$E($P(^SRF($S($D(SRTN):SRTN,1:DA(2)),0),"^",9),1,7),X=$S(X?1.4N.A!(X?1.2N1":"2N.A):Z_"@"_X,1:X) K %DT,Z S %DT="PTXR" D ^%DT S X=Y I Y<1 D OUT Q
67 S SRSTART=$P(^SRF(DA(2),SRSUB,DA(1),1,DA,0),"^",SRP)
68COMP I X<SRSTART W !!,"Time Off should be later than Time On.",! S X=-1
69OUT K %DT,SR130,SRN,SRP,SRSTART,SRSUB
70 Q
71TERM ; compare stop time with start time
72 N SRINOR,SRSTART,SRV,SRY,T,Z
73 I $D(DA) S SRINOR=$S($P($G(^SRF(DA,"NON")),"^")="Y":$P($G(^SRF(DA,"NON")),"^",4),1:$P($G(^SRF(DA,.2)),"^",10)) I 'SRINOR D K X D OUT Q
74 .D EN^DDIOL(">>> Please enter 'TIME "_$S($P($G(^SRF(DA,"NON")),"^")="Y":"PROCEDURE BEGAN",1:"PAT IN OR")_"' first !! <<<","","!!?5")
75 .D EN^DDIOL("","","!")
76 S Z=$E(SRINOR,1,7),X=$S(X?1.4N.A!(X?1.2N1":"2N.A):Z_"@"_X,1:X)
77 K %DT,Z S %DT="PTXR" D ^%DT S X=Y I Y<1 D OUT Q
78 I $D(DA) S Z=$P($G(^SRF(DA,SRN)),"^",SRP),SRSTART=$S(Z:Z,1:SRINOR),SRNULL=$S(Z:0,1:1) I X<SRSTART S Z=$P(SRINOR,"."),T=$P(X,".",2),X1=Z_"."_T,X2=1 D C^%DTC D PLUS24 I '$D(X) D OUT Q
79 K %DT S %DT="EPTXR" D ^%DT S X=Y D OUT
80 Q
81PLUS24 S:SRNULL SR130="TIME PAT IN OR" S (SRV,Y)=X X ^DD("DD") S SRY=Y
82 K DIR S DIR("A",1)="",DIR("A",2)="The time you have entered is earlier than "_SR130_".",DIR("A")="Do you mean "_SRY_" (Y/N) ? ",DIR(0)="YA" D ^DIR K DIR I 'Y!$D(DTOUT)!$D(DUOUT) K X Q
83 S X=SRV
84 Q
85CLEAR ; clean-up case edit/lock flags in ^XTMP
86 N SRC,SRJ,SRL,SRNOW,SRNOW1,SRZ S SRNOW=$$NOW^XLFDT
87 S SRC="SRLOCK-0" F S SRC=$O(^XTMP(SRC)) Q:SRC'["SRLOCK-" D
88 .S SRJ=0 F S SRJ=$O(^XTMP(SRC,DUZ,SRJ)) Q:'SRJ D
89 ..I SRJ=$J L -^XTMP(SRC,DUZ,SRJ) K ^XTMP(SRC,DUZ,SRJ) I '$O(^XTMP(SRC,0)) L -^XTMP(SRC) K ^XTMP(SRC) Q
90 ..S SRNOW1=$P($G(^XTMP(SRC,0)),"^") I SRNOW>SRNOW1 L -^XTMP(SRC) K ^XTMP(SRC)
91 Q
92EN3 ; the Sterility Expiration Date should be after the Date of Operation
93 S:$D(SRTN) SRTDA=DA,DA=SRTN S X=$S(X?1.4N.A!(X?1.2N1":"2N.A):Z_"@"_X,1:X)
94 S %DT="E" D ^%DT S X=Y I X>0 S SRSTART=$E($P(^SRF($S($D(SRTN):SRTN,1:D0),0),U,9),1,7) I SRSTART'="" D BEF
95 S:$D(SRTDA) DA=SRTDA Q
96BEF I X<SRSTART W !!,"The date entered is before the 'DATE OF OPERATION'. Please check the",!,"DATE entered for this field." K X H 2
97 Q
Note: See TracBrowser for help on using the repository browser.