Changeset 623 for WorldVistAEHR/trunk/r/SURGERY-SR/SROALM.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/SURGERY-SR/SROALM.m
r613 r623 1 SROALM ;BIR/ADM - LIST OF ASSESSMENTS MISSING INFORMATION ;12/05/072 ;;3.0; Surgery ;**38,50,88,142,153,160,166**;24 Jun 93;Build 73 4 5 6 7 8 9 10 11 12 13 14 15 UTL 16 17 18 19 20 SRSD 21 22 CASE 23 24 25 26 27 28 PRINT 29 30 31 32 33 34 35 36 37 38 39 40 41 42 F S SRFLD=$O(SRX(SRFLD)) Q:SRFLD="" D:$Y+5>IOSL PAGE Q:SRSOUT W !,$J(CNT_". ",8),$P(SRX(SRFLD),":") S CNT=CNT+143 44 45 OTHER 46 47 48 49 50 LOOP 51 52 53 PAGE 54 55 56 HDR 57 58 59 60 61 62 TOT 63 64 GRAND 65 66 67 1 SROALM ;BIR/ADM - LIST OF ASSESSMENTS MISSING INFORMATION ;02/08/07 2 ;;3.0; Surgery ;**38,50,88,142,153,160**;24 Jun 93;Build 7 3 S (GRAND,SRNEW,SRSOUT,TOT)=0,(SRHDR,SRPAGE)=1,SRTITLE="COMPLETED/TRANSMITTED ASSESSMENTS MISSING INFORMATION" K ^TMP("SRA",$J) 4 I SRFLG,SRASP S SRSPEC=$P(^SRO(137.45,SRASP,0),"^") 5 F S SRSD=$O(^SRF("AC",SRSD)) Q:'SRSD!(SRSD>SRED)!SRSOUT S SRTN=0 F S SRTN=$O(^SRF("AC",SRSD,SRTN)) Q:'SRTN!SRSOUT D 6 .S SR("RA")=$G(^SRF(SRTN,"RA")) I $P(SR("RA"),"^")="C"!($P(SR("RA"),"^")="T"),$D(^SRF(SRTN,0)),$$MANDIV^SROUTL0(SRINSTP,SRTN) D UTL 7 I SRSP S SRSS="" F S SRSS=$O(^TMP("SRA",$J,SRSS)) Q:SRSS="" D SRSD Q:SRSOUT D:TOT TOT 8 I 'SRSP S SRNEW=1,(SRSD,TOT)=0 F S SRSD=$O(^TMP("SRA",$J,SRSD)) Q:'SRSD!SRSOUT S SRTN=0 F S SRTN=$O(^TMP("SRA",$J,SRSD,SRTN)) Q:'SRTN S SRA=^(SRTN) D CASE Q:SRSOUT 9 Q:SRSOUT I SRSP,'SRFLG,GRAND D GRAND 10 I SRFLG,'GRAND S SRSS=SRSPEC D HDR,GRAND 11 I SRSP,'SRFLG,'GRAND S SRSS="" D HDR,GRAND 12 I 'SRSP,'GRAND S SRSS="" D HDR,GRAND 13 I 'SRSP,GRAND S SRSS="" D GRAND 14 Q 15 UTL ; set up TMP global 16 I SRFLG,$P(^SRF(SRTN,0),"^",4)'=SRASP Q 17 I SRSP S SRSS=$P(^SRF(SRTN,0),"^",4),SRSS=$S(SRSS:$P(^SRO(137.45,SRSS,0),"^"),1:"SPECIALTY NOT ENTERED"),^TMP("SRA",$J,SRSS,SRSD,SRTN)=SR("RA") Q 18 S ^TMP("SRA",$J,SRSD,SRTN)=SR("RA") 19 Q 20 SRSD S SRNEW=1,(SRSD,TOT)=0 F S SRSD=$O(^TMP("SRA",$J,SRSS,SRSD)) Q:'SRSD!SRSOUT S SRTN=0 F S SRTN=$O(^TMP("SRA",$J,SRSS,SRSD,SRTN)) Q:'SRTN S SRA=^(SRTN) D CASE Q:SRSOUT 21 Q 22 CASE I $P(SRA,"^",2)="N",$P(SRA,"^",6)="Y" S SRATYPE="NON-CARDIAC" D CHK^SROAUTL 23 I $P(SRA,"^",2)="N",$P(SRA,"^",6)="N" S SRATYPE="EXCLUDED" D CHK^SROAUTL3 24 I $P(SRA,"^",2)="C" S SRATYPE="CARDIAC" D CHK^SROAUTLC 25 S SRFLD="" I $O(SRX(SRFLD))'="" S TOT=TOT+1,GRAND=GRAND+1 D PRINT Q 26 I '$P($G(^SRO(136,SRTN,10)),"^")!('$P($G(^SRO(136,SRTN,0)),"^",2))!('$P($G(^SRO(136,SRTN,0)),"^",3)) D PRINT 27 Q 28 PRINT ; print assessments 29 K SRCPTT S SRCPTT="NOT ENTERED" 30 I $Y+5>IOSL!SRNEW D PAGE I SRSOUT Q 31 S SRA(0)=^SRF(SRTN,0),DFN=$P(SRA(0),"^") N I D DEM^VADPT S SRANM=VADM(1),SRASSN=VA("PID") K VADM 32 I $L(SRANM)>19 S SRANM=$P(SRANM,",")_","_$E($P(SRANM,",",2))_"." 33 S SROPER=$P(^SRF(SRTN,"OP"),"^") I $O(^SRF(SRTN,13,0)) S SROTHER=0 F I=0:0 S SROTHER=$O(^SRF(SRTN,13,SROTHER)) Q:'SROTHER D OTHER 34 K SROPS,MM,MMM S:$L(SROPER)<63 SROPS(1)=SROPER I $L(SROPER)>62 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM="" 35 S SRSTATUS=$S($P(SRA,"^")="T":"TRANSMITTED",1:"COMPLETE"),Y=SRSD D D^DIQ S SRDT=$P(Y,"@") 36 I $Y+5>IOSL D PAGE I SRSOUT Q 37 W !,SRTN,?18,SRANM_" "_VA("PID"),?53,SRATYPE,?68,SRSTATUS,!,SRDT F I=1:1 Q:'$D(SROPS(I)) W ?18,SROPS(I),! 38 N I,SRPROC,SRL S SRL=100 D CPTS^SROAUTL0 W ?18,"CPT Codes: " 39 F I=1:1 Q:'$D(SRPROC(I)) W:I=1 ?29,SRPROC(I) W:I'=1 !,?29,SRPROC(I) 40 S CNT=1 W !,?5,"Missing information:" 41 I '$P($G(^SRO(136,SRTN,10)),"^")!('$P($G(^SRO(136,SRTN,0)),"^",2))!('$P($G(^SRO(136,SRTN,0)),"^",3)) W !,$J(CNT_". ",8),"The final coding for Procedure and Diagnosis is not complete." S CNT=CNT+1 42 F S SRFLD=$O(SRX(SRFLD)) Q:SRFLD="" D:$Y+5>IOSL PAGE Q:SRSOUT W !,$J(CNT_". ",8),SRX(SRFLD) S CNT=CNT+1 43 I 'SRSOUT W ! F LINE=1:1:80 W "-" 44 Q 45 OTHER ; other operations 46 S SRLONG=1 I $L(SROPER)+$L($P(^SRF(SRTN,13,SROTHER,0),"^"))>125 S SRLONG=0,SROTHER=999,SROPERS=" ..." 47 I SRLONG S SROPERS=$P(^SRF(SRTN,13,SROTHER,0),"^") 48 S SROPER=SROPER_$S(SROPERS'=" ...":", "_SROPERS,1:SROPERS) 49 Q 50 LOOP ; break procedures 51 S SROPS(M)="" F LOOP=1:1 S MM=$P(SROPER," "),MMM=$P(SROPER," ",2,200) Q:MMM="" Q:$L(SROPS(M))+$L(MM)'<63 S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM 52 Q 53 PAGE I $E(IOST)="P"!SRHDR G HDR 54 W !!,"Press <RET> to continue, or '^' to quit " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q 55 I X["?" W !!,"If you want to continue listing incomplete assessments, enter <RET>. Enter",!,"'^' to return to the menu." G PAGE 56 HDR ; print heading 57 W @IOF,!,?(80-$L(SRTITLE)\2),SRTITLE,?70,$J("PAGE "_SRPAGE,9) W:$E(IOST)="P" !,?(80-$L(SRINST)\2),SRINST W !,?(80-$L(SRFRTO)\2),SRFRTO 58 W:$E(IOST)="P" !,?(80-$L(SRPRINT)\2),SRPRINT I SRSP,SRSS'="" W !!,"** "_SRSS 59 W !!,"ASSESSMENT #",?18,"PATIENT",?53,"TYPE",?68,"STATUS",!,"OPERATION DATE",?18,"OPERATION(S)",! F LINE=1:1:80 W "=" 60 S SRHDR=0,SRNEW=0,SRPAGE=SRPAGE+1 61 Q 62 TOT W !!,"TOTAL FOR "_SRSS_": ",TOT 63 Q 64 GRAND I 'SRSP W !!,"TOTAL: ",GRAND Q 65 I SRSP,'SRFLG W !!,"TOTAL FOR ALL SPECIALTIES: ",GRAND Q 66 I SRSP,SRFLG S SRSS=SRSPEC D TOT 67 Q
Note:
See TracChangeset
for help on using the changeset viewer.