| [613] | 1 | SROATCM ;BIR/MAM - TRANSMIT CARDIAC ASSESSMENTS ;03/02/06
|
|---|
| 2 | ;;3.0; Surgery ;**38,55,68,90,93,95,99,125,153**;24 Jun 93;Build 11
|
|---|
| 3 | ;
|
|---|
| 4 | ; Reference to ^DGPM("APTT1" supported by DBIA #565
|
|---|
| 5 | ; Reference to File #405 supported by DBIA #3029
|
|---|
| 6 | ; Reference to Field #27.02 in File #2 supported by DBIA #1850
|
|---|
| 7 | ;
|
|---|
| 8 | K ^TMP("SRA",$J) S SRATOT=0,SRASITE=+$P($$SITE^SROVAR,"^",3),(SRAMNUM,SRACNT)=1
|
|---|
| 9 | S SRADFN=0 F S SRADFN=$O(^SRF("ARS","C","C",SRADFN)) Q:'SRADFN S SRTN=0 F S SRTN=$O(^SRF("ARS","C","C",SRADFN,SRTN)) Q:'SRTN D STUFF
|
|---|
| 10 | S SRATOTM=SRAMNUM D ^SROATCM2
|
|---|
| 11 | Q
|
|---|
| 12 | STUFF ; stuff entries into ^TMP("SRA",$J
|
|---|
| 13 | ; check for fouled up ARS x ref
|
|---|
| 14 | I $P(^SRF(SRTN,"RA"),"^",2)="N" K ^SRF("ARS","C","C",SRADFN,SRTN) K DR S DIE=130,DR="235///C",DA=SRTN D ^DIE K DR Q
|
|---|
| 15 | ; the next line is commented out to allow re-transmissions
|
|---|
| 16 | ;S SRART=$P(^SRF(SRTN,"RA"),"^",3) I SRART S DIE=130,DR="235///T",DA=SRTN D ^DIE K DR,DA,DIE Q
|
|---|
| 17 | I $P(^SRF(SRTN,"RA"),"^",2)'="C" Q
|
|---|
| 18 | I SRACNT>100 S SRACNT=1,SRAMNUM=SRAMNUM+1
|
|---|
| 19 | S SRATOT=SRATOT+1 K SRA,VADM
|
|---|
| 20 | F I=0,200,205:1:208 S SRA(I)=$G(SRF(SRTN,I))
|
|---|
| 21 | D ^SROATCM1,P93
|
|---|
| 22 | K SHEMP,SRA,VADM,VAPA
|
|---|
| 23 | S X=$E($P(^SRF(SRTN,0),"^",9),1,5)_"00",^TMP("SRWL",$J,X)=""
|
|---|
| 24 | Q
|
|---|
| 25 | P93 ; referring & follow-up sites, patient address & phone number
|
|---|
| 26 | N SRPREF,SRREF,SRREFP,SRFOL,SRFOLP,SRSOUT,SRY S (SRPREF,SRREF,SRREFP,SRFOL,SRFOLP)="",SRSOUT=0,(VAIP("D"),SRSDATE)=$P(SRA(0),"^",9) D IN5^VADPT
|
|---|
| 27 | ; if not admitted before surgery, look for admission within 24 hours of leaving OR
|
|---|
| 28 | I 'VAIP(13) S X1=$P($G(^SRF(SRTN,.2)),"^",12),X2=1 D C^%DTC S SR24=X,SRDT=$O(^DGPM("APTT1",DFN,SRSDATE)) G:'SRDT!(SRDT>SR24) TS S VAIP("D")=SRDT D IN5^VADPT
|
|---|
| 29 | TS I VAIP(13) K DA,DIC,DIQ,DR S DIC=405,DR=.05,DA=VAIP(13),DIQ="SRY",DIQ(0)="IE" D EN^DIQ1 S SRREF=SRY(405,VAIP(13),.05,"E"),SRREFP=SRY(405,VAIP(13),.05,"I") I SRREFP S SRREFP=$$GET1^DIQ(4,SRREFP,99)
|
|---|
| 30 | I VAIP(17) K DA,DIC,DIQ,DR,SRY S DIC=405,DR=.05,DA=VAIP(17),DIQ="SRY",DIQ(0)="IE" D EN^DIQ1 S SRFOL=SRY(405,VAIP(17),.05,"E"),SRFOLP=SRY(405,VAIP(17),.05,"I") I SRFOLP S SRFOLP=$$GET1^DIQ(4,SRFOLP,99)
|
|---|
| 31 | S SHEMP=$E(SHEMP,1,11)_" 18"_$J(VAPA(1),35)_$J(VAPA(2),30),^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP,SRACNT=SRACNT+1
|
|---|
| 32 | S SHEMP=$E(SHEMP,1,11)_" 19"_$J(VAPA(3),30)_$J(VAPA(4),15)
|
|---|
| 33 | K DA,DIC,DIQ,DR,SRY S X=$P(VAPA(5),"^") I X S DIC=5,DA=X,DR=1,DIQ="SRY",DIQ(0)="E" D EN^DIQ1 S X=SRY(5,$P(VAPA(5),"^"),1,"E")
|
|---|
| 34 | S SHEMP=SHEMP_$J(X,5),^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP,SRACNT=SRACNT+1,SHEMP=$E(SHEMP,1,11)_" 20"_$J(VAPA(8),20)_$J($TR(SRREF,","," "),30)_$J(SRREFP,6)
|
|---|
| 35 | K DA,DIC,DIQ,DR,SRY S DIC="^DPT(",DIQ="SRY",DIQ(0)="I",DA=DFN,DR=27.02 D EN^DIQ1 S X=$G(SRY(2,DFN,27.02,"I")) I X S SRPREF=$$GET1^DIQ(4,X,99)
|
|---|
| 36 | S SHEMP=SHEMP_$J(SRPREF,6)
|
|---|
| 37 | S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP,SRACNT=SRACNT+1,SHEMP=$E(SHEMP,1,11)_" 21"_$J($TR(SRFOL,","," "),30)_$J(SRFOLP,6)
|
|---|
| 38 | S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP,SRACNT=SRACNT+1
|
|---|
| 39 | S SHEMP=$E(SHEMP,1,11)_" 22"_$J($P(SRA(201),"^",21),6)_$J($P(SRA(202),"^",21),7)_$J($P(SRA(201),"^",22),6)_$J($P(SRA(202),"^",22),7)
|
|---|
| 40 | S SHEMP=SHEMP_$J($P(SRA(201),"^",23),6)_$J($P(SRA(202),"^",23),7)_$J($P(SRA(201),"^",24),6)_$J($P(SRA(202),"^",24),7)
|
|---|
| 41 | S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP,SRACNT=SRACNT+1
|
|---|
| 42 | ;
|
|---|
| 43 | S DFN=$P(^SRF(SRTN,0),"^") D DEM^VADPT S SHEMP=$E(SHEMP,1,11)_" 23"_$J($P(SRA(201),"^",25),6)_$J($P(SRA(202),"^",25),7)_$J($P(SRA(201),"^",26),6)_$J($P(SRA(202),"^",26),7)_$J($P(VADM(3),"^"),7) K VADM
|
|---|
| 44 | S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP,SRACNT=SRACNT+1
|
|---|
| 45 | S SHEMP=$E(SHEMP,1,11)_" 24"_$J($P(SRA(208),"^",10),2)_$J($P(SRA(206),"^",38),2)_$J($P(SRA(207),"^",24),2)_$J($P(SRA(207),"^",25),2)_$J($P(SRA(206),"^",39),2)
|
|---|
| 46 | N SR22,SR23 S SR22=$P(SRA(208),"^",22),SR23=$P(SRA(208),"^",23)
|
|---|
| 47 | D NMCS S SHEMP=SHEMP_$J(SRIP,2)_$J(" ",2)_$S(SR22:$J(SR22,12,4),1:$J(SR22,12))_$S(SR23:$J(SR23,12,4),1:$J(SR23,12))_$J($P(SRA(206),"^",41),2)
|
|---|
| 48 | S SHEMP=SHEMP_$J($P(SRA(207),"^",26),3)
|
|---|
| 49 | ;
|
|---|
| 50 | N VAINDT,SRPTF,SRRES,SRDISTYP
|
|---|
| 51 | S VAINDT=$P(SRA(208),"^",15)-.0001 D INP^VADPT S SRPTF=VAIN(10)
|
|---|
| 52 | S SRRES="" D RPC^DGPTFAPI(.SRRES,SRPTF)
|
|---|
| 53 | S SRRES(0)=$G(SRRES(0)),SRRES(1)=$G(SRRES(1)),SRRES(2)=$G(SRRES(2))
|
|---|
| 54 | S SRDISTYP=$P(SRRES(1),U)
|
|---|
| 55 | I SRDISTYP]"" S SRDISTYP=$S(SRDISTYP="REGULAR":1,SRDISTYP="NBC OR WHILE ASIH":2,SRDISTYP="EXPIRATION 6 MONTH LIMIT":3,SRDISTYP="IRREGULAR":4,SRDISTYP="TRANSFER":5,SRDISTYP="DEATH WITH AUTOPSY":6,SRDISTYP="DEATH WITHOUT AUTOPSY":7,1:"")
|
|---|
| 56 | S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP_$J($P(SRRES(1),U,3),7),SRACNT=SRACNT+1
|
|---|
| 57 | S SHEMP=$E(SHEMP,1,11)_" 25"_$J(SRDISTYP,2) I $D(SRRES(2)) F I=1:1:9 S SHEMP=SHEMP_$J($P(SRRES(2),"^",I),7)
|
|---|
| 58 | S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP,SRACNT=SRACNT+1
|
|---|
| 59 | D ^SROATCM3
|
|---|
| 60 | Q
|
|---|
| 61 | NMCS S SRIP=$P(SRA(206),"^",40) I SRIP'="Y" Q
|
|---|
| 62 | N SROCC S SROCC=0 F S SROCC=$O(^SRF(SRTN,10,SROCC)) Q:'SROCC I $P(^SRF(SRTN,10,SROCC,0),"^",2)=34 S SRIP="I" Q
|
|---|
| 63 | I SRIP="Y" S SROCC=0 F S SROCC=$O(^SRF(SRTN,16,SROCC)) Q:'SROCC I $P(^SRF(SRTN,16,SROCC,0),"^",2)=34 S SRIP="P" Q
|
|---|
| 64 | Q
|
|---|
