Changeset 623 for WorldVistAEHR/trunk/r/SURGERY-SR/SROATMNO.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/SURGERY-SR/SROATMNO.m
r613 r623 1 SROATMNO ;BIR/MAM - TRANSMIT NO ASSESSMENT ;12/18/07 2 ;;3.0; Surgery ;**27,38,47,62,68,79,83,81,88,93,95,97,129,125,142,153,160,166**;24 Jun 93;Build 7 3 ;** NOTICE: This routine is part of an implementation of a nationally 4 ;** controlled procedure. Local modifications to this routine 5 ;** are prohibited. 6 ; 7 ; Reference to ^DIC(45.3 supported by DBIA #218 8 ; 9 N SR10SP,SRINTUB,SR95PO,SRLO,SRPID,TDATE K ^TMP("SRA",$J) S SRATOT=0,SRASITE=+$P($$SITE^SROVAR,"^",3),(SRAMNUM,SRACNT)=1 10 S Z=$E(DT,1,3)-1,SRLO=Z_"0214" 11 S TDATE=0 F S TDATE=$O(^SRF("AQ",TDATE)) Q:TDATE="" I DT'<TDATE S SRTN=0 F S SRTN=$O(^SRF("AQ",TDATE,SRTN)) Q:'SRTN D SET 12 S SRATOTM=SRAMNUM D ^SROATM4 13 Q 14 SET I $P($G(^SRF(SRTN,.4)),"^",2)="T"!(TDATE<SRLO) K ^SRF("AQ",TDATE,SRTN) Q 15 I $P($G(^SRF(SRTN,30)),"^")!$P($G(^SRF(SRTN,31)),"^",8)!'$P($G(^SRF(SRTN,.2)),"^",12)!($P($G(^SRF(SRTN,"NON")),"^")="Y") K ^SRF("AQ",TDATE,SRTN) S $P(^SRF(SRTN,.4),"^",2)="" Q 16 I $P($G(^SRF(SRTN,"RA")),"^",6)="Y",$P($G(^SRF(SRTN,"RA")),"^",2)="N" K ^SRF("AQ",TDATE,SRTN) Q 17 I $P($G(^SRF(SRTN,0)),"^",9)="" K ^SRF("AQ",TDATE,SRTN) Q 18 S SR10SP=" " K DA,DIE,DR S DA=SRTN,DIE=130,DR="905///R" D ^DIE K DR,DA,DIE 19 S SRA(0)=^SRF(SRTN,0),DATE=$E($P(SRA(0),"^",9),1,7),SPEC=$P(SRA(0),"^",4) S:SPEC SPEC=$P(^DIC(45.3,$P(^SRO(137.45,SPEC,0),"^",2),0),"^") 20 S EMERG=$P(SRA(0),"^",10),EMERG=$S(EMERG="EM":"Y",1:"N") 21 K SRTECH,SRZ S SRT=0 F S SRT=$O(^SRF(SRTN,6,SRT)) Q:'SRT D ^SROPRIN Q:$D(SRZ) 22 I $D(SRTECH) S SRINTUB=$P($G(^SRF(SRTN,6,SRT,8)),"^",2) 23 I '$D(SRTECH) S (SRTECH,SRINTUB)="" 24 S CPT=$P($G(^SRO(136,SRTN,0)),"^",2),SRPMOD="" I CPT S CPT=$P($$CPT^ICPTCOD(CPT),"^",2) D 25 .S SRM=0,SRCNT=1 F S SRM=$O(^SRO(136,SRTN,1,SRM)) Q:'SRM D Q:SRCNT>5 26 ..S X=$P(^SRO(136,SRTN,1,SRM,0),"^") I X S Y=$P($$MOD^ICPTMOD(X,"I"),"^",2),SRPMOD=SRPMOD_Y,SRCNT=SRCNT+1 27 S DFN=$P(SRA(0),"^") N I D DEM^VADPT S SRDOB=$E($P(VADM(3),"^"),1,7),SRDEATH=$P(VADM(6),U) 28 S SRPID=VA("PID"),SRPID=$TR(SRPID,"-","") ; remove hyphens from PID 29 S X=$$SITE^SROUTL0(SRTN),SRDIV=$S(X:$P(^SRO(133,X,0),"^"),1:""),SRDIV=$S(SRDIV:$$GET1^DIQ(4,SRDIV,99),1:SRASITE) 30 D RS^SROATM2 31 S SRMAJMIN=$E($P($G(^SRF(SRTN,0)),U,3),1) 32 S SRDTHUR=$E($P($G(^SRF(SRTN,.4)),U,7),1) 33 S SRSTATUS=$E($P($G(^SRF(SRTN,0)),U,12),1) I SRSTATUS'="I"&(SRSTATUS'="O") S VAIP("D")=$P(SRA(0),"^",9) D IN5^VADPT S SRSTATUS=$S(VAIP(13):"I",1:"O") K VAIP 34 S SRAGE="" I $P(VADM(3),"^") S SRAGE=$E(DATE,1,3)-$E($P(VADM(3),"^"),1,3)-($E(DATE,4,7)<$E($P(VADM(3),"^"),4,7)) 35 S SRASA="",Y=$P($G(^SRF(SRTN,1.1)),"^",3) S:Y X=$P($P($G(^SRO(132.8,Y,0)),"^"),"-"),SRASA=$E(X,1,2) 36 ; Admission wi 14 days following outpatient surgery due to an Occurrence 37 S (SRADMIT,SRADMT)=0 I SRSTATUS="O" D ADM^SROQ0A S SRADMIT=$S(SRADMT=0:"0",1:"1") 38 S EXC=$P($G(^SRF(SRTN,"RA")),"^",7),SRWOUND=$P($G(^SRF(SRTN,"1.0")),"^",8) 39 D OCC 40 S SRNODE=" X" S:$P($G(^SRF(SRTN,"RA")),U,6)="N" SRNODE=" *" S:$P($G(^SRF(SRTN,"RA")),U,2)="C" SRNODE=" C" 41 S SRTEMP="/"_$J(SRASITE,3)_$J(SRTN,7)_SRNODE_$J(DATE,7)_$J(SRTECH,3)_$J(EMERG,1)_$J(SPEC,3)_$J(CPT,5)_$J(EXC,1)_$J(SRPID,20)_$J(SRDIV,6)_" " 42 S SRTEMP=SRTEMP_$J(SRMAJMIN,1)_$J($E(SRDEATH,1,7),7)_$J(SRDTHUR,1)_$J(SRSTATUS,1)_$J(SRAGE,3)_$J(SRASA,2)_$J(SRADMIT,1)_SRTMP 43 K CPT,SRMOD F SRZ=1:1:10 S (CPT(SRZ),SRMOD(SRZ))="" 44 S (OPS,CNT)=0 F S OPS=$O(^SRO(136,SRTN,3,OPS)) Q:'OPS!(CNT=10) S CNT=CNT+1,X=$P($G(^SRO(136,SRTN,3,OPS,0)),"^") I X S CPT(CNT)=$P($$CPT^ICPTCOD(X),"^",2) D MOD 45 S SRCC=$P($G(^SRF(SRTN,"CON")),"^"),SRBLANK=" " 46 I SRCC,$P($G(^SRF(SRCC,30)),"^")!($P($G(^SRF(SRCC,31)),"^",8)) S SRCC="" 47 S SRTEMP=SRTEMP_$J(CPT(1),5)_$J(CPT(2),5)_$J(CPT(3),5)_$J(CPT(4),5)_$J(CPT(5),5)_$J(CPT(6),5)_$J(CPT(7),5)_$J(CPT(8),5)_$J(CPT(9),5)_$J(CPT(10),5)_$J(SRWOUND,2)_$J(SROCTYPE,1)_SRBLANK_$J(SRCC,10)_$J(SRDEATH,12) 48 S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SRTEMP,SRACNT=SRACNT+1 49 S SRICD=$P($G(^SRO(136,SRTN,0)),"^",3) S:SRICD SRICD=$P(^ICD9(SRICD,0),"^") 50 S SRA(.2)=$G(^SRF(SRTN,.2)) 51 S SRTEMP="/"_$J(SRASITE,3)_$J(SRTN,7)_" B"_$J($E($P(SRA(.2),"^"),1,12),12)_$J($E($P(SRA(.2),"^",4),1,12),12)_$E(SRPMOD_SR10SP,1,10) 52 F I=1:1:10 S SRTEMP=SRTEMP_$E(SRMOD(I)_SR10SP,1,10) 53 S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SRTEMP_$J(SRINTUB,1)_SR95PO_$J(SRATT,2)_$J(SRDOB,7)_$J(SRICD,6)_$J(SROC(38),2),SRACNT=SRACNT+1 54 I SRACNT>100 S SRACNT=1,SRAMNUM=SRAMNUM+1 55 S SRATOT=SRATOT+1 56 S X=$E($P(^SRF(SRTN,0),"^",9),1,5)_"00",^TMP("SRWL",$J,X)="" 57 K DATE,ANES,EMERG,EXC,SPEC,SRADMIT,SRADMT,SRATT,SRBLANK,SRCC,SRDIV,SRDOB,SRDTHUR,SRICD,SRIO,SRMAJMIN,SROCTYPE,SRTEMP,SRTMP,SRWOUND,SRZ,SR14,CPT 58 Q 59 OCC ; total of each occurrence by category 60 N SRIOFLAG,SRPOFLAG 61 F SRK=1:1:38 S SROC(SRK)="" 62 S (SRPO,SRIOFLAG)=0 F S SRPO=$O(^SRF(SRTN,10,SRPO)) Q:'SRPO S SRSUB=$P(^SRF(SRTN,10,SRPO,0),U,2) I SRSUB'="" D 63 .S SROC(SRSUB)=SROC(SRSUB)+1,SRIOFLAG=1 64 S (SRPO,SRPOFLAG)=0 F S SRPO=$O(^SRF(SRTN,16,SRPO)) Q:'SRPO S SRSUB=$P(^SRF(SRTN,16,SRPO,0),U,2) I SRSUB'="" D 65 .S SROC(SRSUB)=SROC(SRSUB)+1,SRPOFLAG=1 66 S (SROCTYPE,SRTMP)="" F SRK=1:1:10 S SRTMP=SRTMP_$J(SROC(SRK),2) 67 S SRTMP=SRTMP_$J(SROC(37),2) F SRK=12:1:32 S SRTMP=SRTMP_$J(SROC(SRK),2) 68 S SR95PO=$J(SROC(33),2)_$J(SROC(34),2)_$J(SROC(35),2)_$J(SROC(36),2) 69 I SRIOFLAG=1,(SRPOFLAG=0) S SROCTYPE="I" 70 I SRIOFLAG=0,(SRPOFLAG=1) S SROCTYPE="P" 71 I SRIOFLAG=1,(SRPOFLAG=1) S SROCTYPE="B" 72 I SRIOFLAG=0,(SRPOFLAG=0) S SROCTYPE="" 73 Q 74 MOD N SRM S SRM=0,SRCNT=1 F S SRM=$O(^SRO(136,SRTN,3,OPS,1,SRM)) Q:'SRM D Q:SRCNT>5 75 .S X=$P(^SRO(136,SRTN,3,OPS,1,SRM,0),"^"),Y=$P($$MOD^ICPTMOD(X,"I"),"^",2) 76 .I Y'="" S SRMOD(CNT)=SRMOD(CNT)_Y,SRCNT=SRCNT+1 77 Q 1 SROATMNO ;BIR/MAM - TRANSMIT NO ASSESSMENT ;05/10/07 2 ;;3.0; Surgery ;**27,38,47,62,68,79,83,81,88,93,95,97,129,125,142,153,160**;24 Jun 93;Build 7 3 ;** NOTICE: This routine is part of an implementation of a nationally 4 ;** controlled procedure. Local modifications to this routine 5 ;** are prohibited. 6 ; 7 ; Reference to ^DIC(45.3 supported by DBIA #218 8 ; 9 N SR10SP,SRINTUB,SR95PO,SRLO,SRPID,TDATE K ^TMP("SRA",$J) S SRATOT=0,SRASITE=+$P($$SITE^SROVAR,"^",3),(SRAMNUM,SRACNT)=1 10 S Z=$E(DT,1,3)-1,SRLO=Z_"0214" 11 S TDATE=0 F S TDATE=$O(^SRF("AQ",TDATE)) Q:TDATE="" I DT'<TDATE S SRTN=0 F S SRTN=$O(^SRF("AQ",TDATE,SRTN)) Q:'SRTN D SET 12 S SRATOTM=SRAMNUM D ^SROATM4 13 Q 14 SET I $P($G(^SRF(SRTN,.4)),"^",2)="T"!(TDATE<SRLO) K ^SRF("AQ",TDATE,SRTN) Q 15 I $P($G(^SRF(SRTN,30)),"^")!$P($G(^SRF(SRTN,31)),"^",8)!'$P($G(^SRF(SRTN,.2)),"^",12)!($P($G(^SRF(SRTN,"NON")),"^")="Y") K ^SRF("AQ",TDATE,SRTN) S $P(^SRF(SRTN,.4),"^",2)="" Q 16 I $P($G(^SRF(SRTN,"RA")),"^",6)="Y",$P($G(^SRF(SRTN,"RA")),"^",2)="N" K ^SRF("AQ",TDATE,SRTN) Q 17 S SR10SP=" " K DA,DIE,DR S DA=SRTN,DIE=130,DR="905///R" D ^DIE K DR,DA,DIE 18 S SRA(0)=^SRF(SRTN,0),DATE=$E($P(SRA(0),"^",9),1,7),SPEC=$P(SRA(0),"^",4) S:SPEC SPEC=$P(^DIC(45.3,$P(^SRO(137.45,SPEC,0),"^",2),0),"^") 19 S EMERG=$P(SRA(0),"^",10),EMERG=$S(EMERG="EM":"Y",1:"N") 20 K SRTECH,SRZ S SRT=0 F S SRT=$O(^SRF(SRTN,6,SRT)) Q:'SRT D ^SROPRIN Q:$D(SRZ) 21 I $D(SRTECH) S SRINTUB=$P($G(^SRF(SRTN,6,SRT,8)),"^",2) 22 I '$D(SRTECH) S (SRTECH,SRINTUB)="" 23 S CPT=$P($G(^SRO(136,SRTN,0)),"^",2),SRPMOD="" I CPT S CPT=$P($$CPT^ICPTCOD(CPT),"^",2) D 24 .S SRM=0,SRCNT=1 F S SRM=$O(^SRO(136,SRTN,1,SRM)) Q:'SRM D Q:SRCNT>5 25 ..S X=$P(^SRO(136,SRTN,1,SRM,0),"^") I X S Y=$P($$MOD^ICPTMOD(X,"I"),"^",2),SRPMOD=SRPMOD_Y,SRCNT=SRCNT+1 26 S DFN=$P(SRA(0),"^") N I D DEM^VADPT S SRDOB=$E($P(VADM(3),"^"),1,7),SRDEATH=$P(VADM(6),U) 27 S SRPID=VA("PID"),SRPID=$TR(SRPID,"-","") ; remove hyphens from PID 28 S X=$$SITE^SROUTL0(SRTN),SRDIV=$S(X:$P(^SRO(133,X,0),"^"),1:""),SRDIV=$S(SRDIV:$$GET1^DIQ(4,SRDIV,99),1:SRASITE) 29 D RS^SROATM2 30 S SRMAJMIN=$E($P($G(^SRF(SRTN,0)),U,3),1) 31 S SRDTHUR=$E($P($G(^SRF(SRTN,.4)),U,7),1) 32 S SRSTATUS=$E($P($G(^SRF(SRTN,0)),U,12),1) I SRSTATUS'="I"&(SRSTATUS'="O") S VAIP("D")=$P(SRA(0),"^",9) D IN5^VADPT S SRSTATUS=$S(VAIP(13):"I",1:"O") K VAIP 33 S SRAGE="" I $P(VADM(3),"^") S SRAGE=$E(DATE,1,3)-$E($P(VADM(3),"^"),1,3)-($E(DATE,4,7)<$E($P(VADM(3),"^"),4,7)) 34 S SRASA="",Y=$P($G(^SRF(SRTN,1.1)),"^",3) S:Y X=$P($P($G(^SRO(132.8,Y,0)),"^"),"-"),SRASA=$E(X,1,2) 35 ; Admission wi 14 days following outpatient surgery due to an Occurrence 36 S (SRADMIT,SRADMT)=0 I SRSTATUS="O" D ADM^SROQ0A S SRADMIT=$S(SRADMT=0:"0",1:"1") 37 S EXC=$P($G(^SRF(SRTN,"RA")),"^",7),SRWOUND=$P($G(^SRF(SRTN,"1.0")),"^",8) 38 D OCC 39 S SRNODE=" X" S:$P($G(^SRF(SRTN,"RA")),U,6)="N" SRNODE=" *" S:$P($G(^SRF(SRTN,"RA")),U,2)="C" SRNODE=" C" 40 S SRTEMP="/"_$J(SRASITE,3)_$J(SRTN,7)_SRNODE_DATE_$J(SRTECH,3)_$J(EMERG,1)_$J(SPEC,3)_$J(CPT,5)_$J(EXC,1)_$J(SRPID,20)_$J(SRDIV,6)_" " 41 S SRTEMP=SRTEMP_$J(SRMAJMIN,1)_$J($E(SRDEATH,1,7),7)_$J(SRDTHUR,1)_$J(SRSTATUS,1)_$J(SRAGE,3)_$J(SRASA,2)_$J(SRADMIT,1)_SRTMP 42 K CPT,SRMOD F SRZ=1:1:10 S (CPT(SRZ),SRMOD(SRZ))="" 43 S (OPS,CNT)=0 F S OPS=$O(^SRO(136,SRTN,3,OPS)) Q:'OPS!(CNT=10) S CNT=CNT+1,X=$P($G(^SRO(136,SRTN,3,OPS,0)),"^") I X S CPT(CNT)=$P($$CPT^ICPTCOD(X),"^",2) D MOD 44 S SRCC=$P($G(^SRF(SRTN,"CON")),"^"),SRBLANK=" " 45 I SRCC,$P($G(^SRF(SRCC,30)),"^")!($P($G(^SRF(SRCC,31)),"^",8)) S SRCC="" 46 S SRTEMP=SRTEMP_$J(CPT(1),5)_$J(CPT(2),5)_$J(CPT(3),5)_$J(CPT(4),5)_$J(CPT(5),5)_$J(CPT(6),5)_$J(CPT(7),5)_$J(CPT(8),5)_$J(CPT(9),5)_$J(CPT(10),5)_$J(SRWOUND,2)_$J(SROCTYPE,1)_SRBLANK_$J(SRCC,10)_$J(SRDEATH,12) 47 S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SRTEMP,SRACNT=SRACNT+1 48 S SRICD=$P($G(^SRO(136,SRTN,0)),"^",3) S:SRICD SRICD=$P(^ICD9(SRICD,0),"^") 49 S SRA(.2)=$G(^SRF(SRTN,.2)) 50 S SRTEMP="/"_$J(SRASITE,3)_$J(SRTN,7)_" B"_$J($E($P(SRA(.2),"^"),1,12),12)_$J($E($P(SRA(.2),"^",4),1,12),12)_$E(SRPMOD_SR10SP,1,10) 51 F I=1:1:10 S SRTEMP=SRTEMP_$E(SRMOD(I)_SR10SP,1,10) 52 S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SRTEMP_$J(SRINTUB,1)_SR95PO_$J(SRATT,2)_$J(SRDOB,7)_$J(SRICD,6)_$J(SROC(38),2),SRACNT=SRACNT+1 53 I SRACNT>100 S SRACNT=1,SRAMNUM=SRAMNUM+1 54 S SRATOT=SRATOT+1 55 S X=$E($P(^SRF(SRTN,0),"^",9),1,5)_"00",^TMP("SRWL",$J,X)="" 56 K DATE,ANES,EMERG,EXC,SPEC,SRADMIT,SRADMT,SRATT,SRBLANK,SRCC,SRDIV,SRDOB,SRDTHUR,SRICD,SRIO,SRMAJMIN,SROCTYPE,SRTEMP,SRTMP,SRWOUND,SRZ,SR14,CPT 57 Q 58 OCC ; total of each occurrence by category 59 N SRIOFLAG,SRPOFLAG 60 F SRK=1:1:38 S SROC(SRK)="" 61 S (SRPO,SRIOFLAG)=0 F S SRPO=$O(^SRF(SRTN,10,SRPO)) Q:'SRPO S SRSUB=$P(^SRF(SRTN,10,SRPO,0),U,2) I SRSUB'="" D 62 .S SROC(SRSUB)=SROC(SRSUB)+1,SRIOFLAG=1 63 S (SRPO,SRPOFLAG)=0 F S SRPO=$O(^SRF(SRTN,16,SRPO)) Q:'SRPO S SRSUB=$P(^SRF(SRTN,16,SRPO,0),U,2) I SRSUB'="" D 64 .S SROC(SRSUB)=SROC(SRSUB)+1,SRPOFLAG=1 65 S (SROCTYPE,SRTMP)="" F SRK=1:1:10 S SRTMP=SRTMP_$J(SROC(SRK),2) 66 S SRTMP=SRTMP_$J(SROC(37),2) F SRK=12:1:32 S SRTMP=SRTMP_$J(SROC(SRK),2) 67 S SR95PO=$J(SROC(33),2)_$J(SROC(34),2)_$J(SROC(35),2)_$J(SROC(36),2) 68 I SRIOFLAG=1,(SRPOFLAG=0) S SROCTYPE="I" 69 I SRIOFLAG=0,(SRPOFLAG=1) S SROCTYPE="P" 70 I SRIOFLAG=1,(SRPOFLAG=1) S SROCTYPE="B" 71 I SRIOFLAG=0,(SRPOFLAG=0) S SROCTYPE="" 72 Q 73 MOD N SRM S SRM=0,SRCNT=1 F S SRM=$O(^SRO(136,SRTN,3,OPS,1,SRM)) Q:'SRM D Q:SRCNT>5 74 .S X=$P(^SRO(136,SRTN,3,OPS,1,SRM,0),"^"),Y=$P($$MOD^ICPTMOD(X,"I"),"^",2) 75 .I Y'="" S SRMOD(CNT)=SRMOD(CNT)_Y,SRCNT=SRCNT+1 76 Q
Note:
See TracChangeset
for help on using the changeset viewer.