Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SROCD

SROCD.m

Go to the documentation of this file.
  1. SROCD ;BIR/ADM - CASE CODING IN SURGERY PROCEDURE/DIAGNOSIS CODES FILE ;07/24/07
  1. ;;3.0; Surgery ;**142,152,159**;24 Jun 93;Build 4
  1. I '$D(SRSITE) D ^SROVAR I '$D(SRSITE) S XQUIT="" Q
  1. I '$G(SRTN) D ^SROPS1 I '$D(SRTN) S XQUIT="" Q
  1. BEG N S,SR2,SRCMOD,SRDES,SRDX,SREDIT,SRHDR,SRMOD,SRNM,SRPROC,SRS,SRSEL,SRTXT
  1. S (SREDIT,SRMOD,SRSOUT,SRS,SR2)=0 I $P($G(^SRF(SRTN,.2)),"^",3) S SRS=1
  1. S S(0)=^SRF(SRTN,0),Y=$P(S(0),"^",9),SRDATE=Y D D^DIQ S SRSDATE=Y,DFN=$P(S(0),"^") D DEM^VADPT S SRNM=VADM(1)_" ("_VA("PID")_")"
  1. S SRNON=$S($P($G(^SRF(SRTN,"NON")),"^")="Y":1,1:0)
  1. I '$D(^SRO(136,SRTN)) D ^SROCD1
  1. I $P($G(^SRO(136,SRTN,10)),"^") D SURE I 'SREDIT Q
  1. EDIT D ^SROCD2 I SRSOUT!SREDIT G END
  1. D EDIT
  1. Q
  1. SURE D HDR K DIR
  1. S DIR("A",1)="Coding for this case has been completed "_$S($P(^SRF(SRTN,0),"^",15):"and",1:"but not")_" sent to PCE."
  1. S DIR("A",2)="",DIR("A")="Are you sure you want to edit this case",DIR(0)="Y",DIR("B")="NO" D ^DIR K DIR
  1. I Y S SREDIT=1 M ^TMP("SRED1",$J,SRTN)=^SRO(136,SRTN) Q
  1. END S SROERR=SRTN D ^SROERR0,^SRSKILL
  1. K ADCNT,SRCOMMA,SRDXCNT,SROCNTR,SROCPT2,SROERR,SROFLG,SRTMP,SRICD9,SRDIAGS,SRASDX,SRMSG,SRADX,SRPADX,SRODIR,REC,SRDIRX,SRADIAG,SRDX,SRDX1,SRDX2,SROICD,SUB4
  1. W @IOF K ^TMP("SRED1",$J)
  1. Q
  1. HDR W @IOF,!,SRNM_" Case #"_SRTN,!
  1. S SRPROC=$P(^SRF(SRTN,"OP"),"^") D BRK W $P(SRSDATE,"@")_" "_SRHDR(1)
  1. I $D(SRHDR(2)) W !,?15,SRHDR(2) I $D(SRHDR(3)) W !,?15,SRHDR(3)
  1. W ! F I=1:1:80 W "-"
  1. Q
  1. BRK ; break procedure if greater than 65 characters
  1. I $L(SRPROC)<66 S SRHDR(1)=SRPROC Q
  1. S X=SRPROC,K=1 F D I $L(X)<66 S SRHDR(K)=X Q
  1. .F I=0:1:64 S J=65-I,Y=$E(X,J) I Y=" " S SRHDR(K)=$E(X,1,J-1),X=$E(X,J+1,$L(X)) S K=K+1 Q
  1. Q
  1. OSCEI ; update SC/EI info on other diagnosis
  1. K DA,DIE,DR,DIR W !!,"Please supply the following required information related to this diagnosis:",!
  1. S SRDR="",SRQ=0 S DA=$P(SRSEL(SRDA),U),DA(1)=SRTN D I SRQ Q
  1. .I $D(SRCL(3)) D SC I SRQ Q
  1. .I $D(SRCL(7)) D CV I SRQ Q
  1. .I $D(SRCL(1)) D AO I SRQ Q
  1. .I $D(SRCL(2)) D IR I SRQ Q
  1. .I $D(SRCL(4)) D EC I SRQ Q
  1. .I $D(SRCL(8)) D PRJ I SRQ Q
  1. .I $D(SRCL(5)) D MST I SRQ Q
  1. .I $D(SRCL(6)) D HNC
  1. K DIR S DA=$P(SRSEL(SRDA),U),DA(1)=SRTN,DIE="^SRO(136,SRTN,4,",DR=SRDR D ^DIE K DA,DIE,DR,SRDR
  1. Q
  1. SC S DIR("A")="Treatment related to Service Connected condition (Y/N)",DIR(0)="136.04,.02" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
  1. I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G SC
  1. S SRCL(3)=Y,SRDR=$G(SRDR)_".02////"_SRCL(3)_";"
  1. Q
  1. CV N SRCVD S SRCVD=$P($G(^SRO(136,DA(1),4,DA,0)),"^",8),DIR("B")=$S(SRCVD=0:"NO",1:"YES")
  1. S DIR("A")="Treatment related to Combat (Y/N)",DIR(0)="136.04,.08" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
  1. I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G CV
  1. S SRCL(7)=Y,SRDR=SRDR_".08////"_SRCL(7)_";"
  1. Q
  1. AO S DIR("A")="Treatment related to Agent Orange Exposure (Y/N)",DIR(0)="136.04,.03" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
  1. I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G AO
  1. S SRCL(1)=Y,SRDR=SRDR_".03////"_SRCL(1)_";"
  1. Q
  1. IR S DIR("A")="Treatment related to Ionizing Radiation Exposure (Y/N)",DIR(0)="136.04,.04" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
  1. I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G IR
  1. S SRCL(2)=Y,SRDR=SRDR_".04////"_SRCL(2)_";"
  1. Q
  1. EC S DIR("A")="Treatment related to SW Asia (Y/N)",DIR(0)="136.04,.07" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
  1. I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G EC
  1. S SRCL(4)=Y,SRDR=SRDR_".07////"_SRCL(4)_";"
  1. Q
  1. PRJ S DIR("A")="Treatment related to PROJ 112/SHAD (Y/N)",DIR(0)="136.04,.09" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
  1. I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G PRJ
  1. S SRCL(8)=Y,SRDR=SRDR_".09////"_SRCL(8)_";"
  1. Q
  1. MST S DIR("A")="Treatment related to Military Sexual Trauma (Y/N)",DIR(0)="136.04,.05" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
  1. I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G MST
  1. S SRCL(5)=Y,SRDR=SRDR_".05////"_SRCL(5)_";"
  1. Q
  1. HNC S DIR("A")="Treatment related to Head and/or Neck Cancer (Y/N)",DIR(0)="136.04,.06" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
  1. I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G HNC
  1. S SRCL(6)=Y,SRDR=SRDR_".06////"_SRCL(6)_";"
  1. Q