- SR62UTL ;BIR/ADM - Post-install process for SR*3*62; [ 03/18/97 11:19 AM ]
- ;;3.0; Surgery ;**62**;24 Jun 93
- Q
- POST S ZTDESC="SR*3*62 - NSQIP Transmission",ZTRTN="TSK^SR62UTL",ZTIO="",ZTDTH=$H D ^%ZTLOAD
- Q
- TSK N SRA,SRCREATE,SRSDATE,SRSTATUS,SRTN,SRTYPE K ^TMP("SR62",$J)
- S SRSDATE=2961000 F S SRSDATE=$O(^SRF("AC",SRSDATE)) Q:+SRSDATE<2961000 S SRTN=0 F S SRTN=$O(^SRF("AC",SRSDATE,SRTN)) Q:'SRTN D
- .Q:'$P($G(^SRF(SRTN,.2)),"^",12)!$P($G(^SRF(SRTN,30)),"^")!($P($G(^SRF(SRTN,"NON")),"^")="Y")
- .S SRA=$G(^SRF(SRTN,"RA")),SRSTATUS=$P(SRA,"^"),SRTYPE=$P(SRA,"^",2),SRCREATE=$P(SRA,"^",6) I (SRTYPE'="N")!(SRSTATUS'="T") D AQ Q
- .I SRSTATUS="T" S ^TMP("SR62",$J,SRTN)="" S $P(^SRF(SRTN,.4),"^",2)="T" Q
- EN1 S SITE=+$P($$SITE^SROVAR,"^",3),(SRY,SRN)=0
- S SRTN=0 F S SRTN=$O(^TMP("SR62",$J,SRTN)) Q:'SRTN D
- .S SRDIV=$P($G(^SRF(SRTN,8)),"^") I SRDIV S SRDIV=$$GET1^DIQ(4,SRDIV,99)
- .S SRNODE=$P(^SRF(SRTN,"RA"),"^",6)
- .S DFN=$P(^SRF(SRTN,0),"^") N I D DEM^VADPT
- .I SRNODE="Y" D ASSESS
- .I SRNODE="N" D EXCLUDE
- D SEND
- QR ; queue quarterly report for first quarter of FY97
- S X=0 F S X=$O(^SRO(133,X)) Q:'X S $P(^SRO(133,X,0),"^",18)=""
- S SRSTART=2961001,SREND=2961231,SRFLG=1,SRT=1 D EN^SROQT
- Q
- EXCLUDE S SRMAJMIN=$E($P($G(^SRF(SRTN,0)),U,3),1)
- S SRDEATH=$E($P($G(^DPT(DFN,.35)),U),1,7)
- S SRDTHUR=$E($P($G(^SRF(SRTN,.4)),U,7),1)
- S SRSTATUS=$E($P($G(^SRF(SRTN,0)),U,12),1)
- S DATE=$E($P(^SRF(SRTN,0),"^",9),1,7),SRAGE=$E(DATE,1,3)-$E($P(VADM(3),"^"),1,3)-($E(DATE,4,7)<$E($P(VADM(3),"^"),4,7))
- K CPT F SRZ=1:1:10 S CPT(SRZ)=""
- S (OPS,CNT)=0 F S OPS=$O(^SRF(SRTN,13,OPS)) Q:'OPS!(CNT=10) S CNT=CNT+1,X=$P($G(^SRF(SRTN,13,OPS,2)),"^") I X S CPT(CNT)=$P(^ICPT(X,0),"^")
- S SRCPT=CPT(1)_"^"_CPT(2)_"^"_CPT(3)_"^"_CPT(4)_"^"_CPT(5)_"^"_CPT(6)_"^"_CPT(7)_"^"_CPT(8)_"^"_CPT(9)_"^"_CPT(10)
- S SRWOUND=$P($G(^SRF(SRTN,0)),"^",16)
- ASSESS S SRASA=$P($G(^SRF(SRTN,1.1)),U,3)
- S SRATTEND=$E($P($G(^SRF(SRTN,.1)),U,16),1) I SRATTEND="" D RS^SROQ0A S SRATTEND=SRATT
- S (SRADMIT,SRADMT)=0 I $E($P($G(^SRF(SRTN,0)),U,12),1)="O" D ADM^SROQ0A S SRADMIT=$S(SRADMT=0:"0",1:"1")
- OCC F SRK=1:1:32 S SROC(SRK)=""
- S (SRPO,SRSUB,SRIOFLAG)=0 F S SRPO=$O(^SRF(SRTN,10,SRPO)) Q:'SRPO S SRSUB=$P(^SRF(SRTN,10,SRPO,0),U,2) I SRSUB'="" S SROC(SRSUB)=SROC(SRSUB)+1,SRIOFLAG=1
- S (SRPO,SRSUB,SRPOFLAG)=0 F S SRPO=$O(^SRF(SRTN,16,SRPO)) Q:'SRPO S SRSUB=$P(^SRF(SRTN,16,SRPO,0),U,2) I SRSUB'="" S SROC(SRSUB)=SROC(SRSUB)+1,SRPOFLAG=1
- S (SROCTYPE,SRTMP)="" F SRK=1:1:32 S SRTMP=SRTMP_SROC(SRK)_"^"
- I SRIOFLAG=1,(SRPOFLAG=0) S SROCTYPE="I"
- I SRIOFLAG=0,(SRPOFLAG=1) S SROCTYPE="P"
- I SRIOFLAG=1,(SRPOFLAG=1) S SROCTYPE="B"
- I SRIOFLAG=0,(SRPOFLAG=0) S SROCTYPE=""
- I SRNODE="Y" S SRY=SRY+1,^TMP("SRAY",$J,SRY)=SITE_"^"_SRDIV_"^"_SRTN_"^"_SRNODE_"^"_SRATTEND_"^"_SRADMIT_"^"_SRTMP_"^"_SRASA_"^"_SROCTYPE
- I SRNODE="N" S SRN=SRN+1,^TMP("SRAN",$J,SRN)=SITE_"^"_SRDIV_"^"_SRTN_"^"_SRNODE_"^"_SRATTEND_"^"_SRADMIT_"^"_SRTMP_"^"_SRMAJMIN_"^"_SRDEATH_"^"_SRDTHUR_"^"_SRSTATUS_"^"_SRAGE_"^"_SRASA_"^"_SRCPT_"^"_SRWOUND_"^"_SROCTYPE
- Q
- SEND ; send message to G.SRCOSERV RISK at Hines ISC
- S ISC=0,NAME=$G(^XMB("NETNAME")) I NAME["FORUM"!(NAME["ISC-")!($E(NAME,1,3)="ISC")!(NAME["ISC.")!(NAME["TST") S ISC=1
- S XMSUB="*** SR*3*62 ASSESSED FROM VAMC-"_SITE_" ***",XMDUZ=^XMB("NETNAME")
- I ISC S XMY("G.RISK ASSESSMENT@"_^XMB("NETNAME"))=""
- I 'ISC S XMY("G.SRCOSERV@ISC-CHICAGO.VA.GOV")=""
- S XMTEXT="^TMP(""SRAY"",$J," N I D ^XMD
- S XMSUB="*** SR*3*62 EXCLUDED FROM VAMC-"_SITE_" ***",XMDUZ=^XMB("NETNAME")
- I ISC S XMY("G.RISK ASSESSMENT@"_^XMB("NETNAME"))=""
- I 'ISC S XMY("G.SRCOSERV@ISC-CHICAGO.VA.GOV")=""
- S XMTEXT="^TMP(""SRAN"",$J," N I D ^XMD
- K DFN,^TMP("SR62"),^TMP("SRAY"),^TMP("SRAN"),SRTN,SITE,SRCAR,SRCNS,SRDA,SRDEATH,SRDFN,SRY,SRN,SROC,SRRES,SRSDATE,SRTDT,SRDTHUR,SRMAJMIN,SRTEMP,SR14,CPT,SRCPT,SRZ,SRZZ,SRDIV,SRADMIT,SRADMT,SRATT,SRK,SRNODE,SRATTEND,SRPO,SRSUB,SRTMP
- S ZTREQ="@"
- Q
- AQ ; set ready to transmit field to ready
- N SRTD D AQDT S $P(^SRF(SRTN,.4),"^",2)="R",^SRF("AQ",SRTD,SRTN)=""
- Q
- AQDT ; get quarterly transmission date for this case
- N SRDAY,SRQTR,SRYR
- S SRYR=$E(SRSDATE,1,3),SRDAY=$E(SRSDATE,4,7),SRQTR=$S(SRDAY<401:2,SRDAY<701:3,SRDAY<1001:4,1:1) I SRQTR=1 S SRYR=SRYR+1
- S SRTD=SRYR_$S(SRQTR=1:"0214",SRQTR=2:"0515",SRQTR=3:"0814",1:"1114")
- Q
- PRE ; pre-install process for SR*3*62
- N SRQOP,SRM,SRMQ
- S SRQOP=$O(^DIC(19,"B","SRO QUARTERLY REPORT",0)),SRM=$O(^DIC(19,"B","SRO-CHIEF REPORTS",0)) Q:'SRQOP!'SRM
- S SRMQ=$O(^DIC(19,SRM,10,"B",SRQOP,0)) Q:'SRMQ D DIK
- S SRQM=$O(^DIC(19,"B","SROQ MENU",0)) Q:'SRQM S SRMQ=$O(^DIC(19,SRM,10,"B",SRQM,0)) Q:'SRMQ
- DIK K DA,DIK S DA(1)=SRM,DA=SRMQ,DIK="^DIC(19,"_DA(1)_",10," D ^DIK K DA,DIK
- Q
- SR62UTL ;BIR/ADM - Post-install process for SR*3*62; [ 03/18/97 11:19 AM ]
- +1 ;;3.0; Surgery ;**62**;24 Jun 93
- +2 QUIT
- POST SET ZTDESC="SR*3*62 - NSQIP Transmission"
- SET ZTRTN="TSK^SR62UTL"
- SET ZTIO=""
- SET ZTDTH=$HOROLOG
- DO ^%ZTLOAD
- +1 QUIT
- TSK NEW SRA,SRCREATE,SRSDATE,SRSTATUS,SRTN,SRTYPE
- KILL ^TMP("SR62",$JOB)
- +1 SET SRSDATE=2961000
- FOR
- SET SRSDATE=$ORDER(^SRF("AC",SRSDATE))
- IF +SRSDATE<2961000
- QUIT
- SET SRTN=0
- FOR
- SET SRTN=$ORDER(^SRF("AC",SRSDATE,SRTN))
- IF 'SRTN
- QUIT
- Begin DoDot:1
- +2 IF '$PIECE($GET(^SRF(SRTN,.2)),"^",12)!$PIECE($GET(^SRF(SRTN,30)),"^")!($PIECE($GET(^SRF(SRTN,"NON")),"^")="Y")
- QUIT
- +3 SET SRA=$GET(^SRF(SRTN,"RA"))
- SET SRSTATUS=$PIECE(SRA,"^")
- SET SRTYPE=$PIECE(SRA,"^",2)
- SET SRCREATE=$PIECE(SRA,"^",6)
- IF (SRTYPE'="N")!(SRSTATUS'="T")
- DO AQ
- QUIT
- +4 IF SRSTATUS="T"
- SET ^TMP("SR62",$JOB,SRTN)=""
- SET $PIECE(^SRF(SRTN,.4),"^",2)="T"
- QUIT
- End DoDot:1
- EN1 SET SITE=+$PIECE($$SITE^SROVAR,"^",3)
- SET (SRY,SRN)=0
- +1 SET SRTN=0
- FOR
- SET SRTN=$ORDER(^TMP("SR62",$JOB,SRTN))
- IF 'SRTN
- QUIT
- Begin DoDot:1
- +2 SET SRDIV=$PIECE($GET(^SRF(SRTN,8)),"^")
- IF SRDIV
- SET SRDIV=$$GET1^DIQ(4,SRDIV,99)
- +3 SET SRNODE=$PIECE(^SRF(SRTN,"RA"),"^",6)
- +4 SET DFN=$PIECE(^SRF(SRTN,0),"^")
- NEW I
- DO DEM^VADPT
- +5 IF SRNODE="Y"
- DO ASSESS
- +6 IF SRNODE="N"
- DO EXCLUDE
- End DoDot:1
- +7 DO SEND
- QR ; queue quarterly report for first quarter of FY97
- +1 SET X=0
- FOR
- SET X=$ORDER(^SRO(133,X))
- IF 'X
- QUIT
- SET $PIECE(^SRO(133,X,0),"^",18)=""
- +2 SET SRSTART=2961001
- SET SREND=2961231
- SET SRFLG=1
- SET SRT=1
- DO EN^SROQT
- +3 QUIT
- EXCLUDE SET SRMAJMIN=$EXTRACT($PIECE($GET(^SRF(SRTN,0)),U,3),1)
- +1 SET SRDEATH=$EXTRACT($PIECE($GET(^DPT(DFN,.35)),U),1,7)
- +2 SET SRDTHUR=$EXTRACT($PIECE($GET(^SRF(SRTN,.4)),U,7),1)
- +3 SET SRSTATUS=$EXTRACT($PIECE($GET(^SRF(SRTN,0)),U,12),1)
- +4 SET DATE=$EXTRACT($PIECE(^SRF(SRTN,0),"^",9),1,7)
- SET SRAGE=$EXTRACT(DATE,1,3)-$EXTRACT($PIECE(VADM(3),"^"),1,3)-($EXTRACT(DATE,4,7)<$EXTRACT($PIECE(VADM(3),"^"),4,7))
- +5 KILL CPT
- FOR SRZ=1:1:10
- SET CPT(SRZ)=""
- +6 SET (OPS,CNT)=0
- FOR
- SET OPS=$ORDER(^SRF(SRTN,13,OPS))
- IF 'OPS!(CNT=10)
- QUIT
- SET CNT=CNT+1
- SET X=$PIECE($GET(^SRF(SRTN,13,OPS,2)),"^")
- IF X
- SET CPT(CNT)=$PIECE(^ICPT(X,0),"^")
- +7 SET SRCPT=CPT(1)_"^"_CPT(2)_"^"_CPT(3)_"^"_CPT(4)_"^"_CPT(5)_"^"_CPT(6)_"^"_CPT(7)_"^"_CPT(8)_"^"_CPT(9)_"^"_CPT(10)
- +8 SET SRWOUND=$PIECE($GET(^SRF(SRTN,0)),"^",16)
- ASSESS SET SRASA=$PIECE($GET(^SRF(SRTN,1.1)),U,3)
- +1 SET SRATTEND=$EXTRACT($PIECE($GET(^SRF(SRTN,.1)),U,16),1)
- IF SRATTEND=""
- DO RS^SROQ0A
- SET SRATTEND=SRATT
- +2 SET (SRADMIT,SRADMT)=0
- IF $EXTRACT($PIECE($GET(^SRF(SRTN,0)),U,12),1)="O"
- DO ADM^SROQ0A
- SET SRADMIT=$SELECT(SRADMT=0:"0",1:"1")
- OCC FOR SRK=1:1:32
- SET SROC(SRK)=""
- +1 SET (SRPO,SRSUB,SRIOFLAG)=0
- FOR
- SET SRPO=$ORDER(^SRF(SRTN,10,SRPO))
- IF 'SRPO
- QUIT
- SET SRSUB=$PIECE(^SRF(SRTN,10,SRPO,0),U,2)
- IF SRSUB'=""
- SET SROC(SRSUB)=SROC(SRSUB)+1
- SET SRIOFLAG=1
- +2 SET (SRPO,SRSUB,SRPOFLAG)=0
- FOR
- SET SRPO=$ORDER(^SRF(SRTN,16,SRPO))
- IF 'SRPO
- QUIT
- SET SRSUB=$PIECE(^SRF(SRTN,16,SRPO,0),U,2)
- IF SRSUB'=""
- SET SROC(SRSUB)=SROC(SRSUB)+1
- SET SRPOFLAG=1
- +3 SET (SROCTYPE,SRTMP)=""
- FOR SRK=1:1:32
- SET SRTMP=SRTMP_SROC(SRK)_"^"
- +4 IF SRIOFLAG=1
- IF (SRPOFLAG=0)
- SET SROCTYPE="I"
- +5 IF SRIOFLAG=0
- IF (SRPOFLAG=1)
- SET SROCTYPE="P"
- +6 IF SRIOFLAG=1
- IF (SRPOFLAG=1)
- SET SROCTYPE="B"
- +7 IF SRIOFLAG=0
- IF (SRPOFLAG=0)
- SET SROCTYPE=""
- +8 IF SRNODE="Y"
- SET SRY=SRY+1
- SET ^TMP("SRAY",$JOB,SRY)=SITE_"^"_SRDIV_"^"_SRTN_"^"_SRNODE_"^"_SRATTEND_"^"_SRADMIT_"^"_SRTMP_"^"_SRASA_"^"_SROCTYPE
- +9 IF SRNODE="N"
- SET SRN=SRN+1
- SET ^TMP("SRAN",$JOB,SRN)=SITE_"^"_SRDIV_"^"_SRTN_"^"_SRNODE_"^"_SRATTEND_"^"_SRADMIT_"^"_SRTMP_"^"_SRMAJMIN_"^"_SRDEATH_"^"_SRDTHUR_"^"_SRSTATUS_"^"_SRAGE_"^"_SRASA_"^"_SRCPT_"^"_SRWOUND_"^"_SROCTYPE
- +10 QUIT
- SEND ; send message to G.SRCOSERV RISK at Hines ISC
- +1 SET ISC=0
- SET NAME=$GET(^XMB("NETNAME"))
- IF NAME["FORUM"!(NAME["ISC-")!($EXTRACT(NAME,1,3)="ISC")!(NAME["ISC.")!(NAME["TST")
- SET ISC=1
- +2 SET XMSUB="*** SR*3*62 ASSESSED FROM VAMC-"_SITE_" ***"
- SET XMDUZ=^XMB("NETNAME")
- +3 IF ISC
- SET XMY("G.RISK ASSESSMENT@"_^XMB("NETNAME"))=""
- +4 IF 'ISC
- SET XMY("G.SRCOSERV@ISC-CHICAGO.VA.GOV")=""
- +5 SET XMTEXT="^TMP(""SRAY"",$J,"
- NEW I
- DO ^XMD
- +6 SET XMSUB="*** SR*3*62 EXCLUDED FROM VAMC-"_SITE_" ***"
- SET XMDUZ=^XMB("NETNAME")
- +7 IF ISC
- SET XMY("G.RISK ASSESSMENT@"_^XMB("NETNAME"))=""
- +8 IF 'ISC
- SET XMY("G.SRCOSERV@ISC-CHICAGO.VA.GOV")=""
- +9 SET XMTEXT="^TMP(""SRAN"",$J,"
- NEW I
- DO ^XMD
- +10 KILL DFN,^TMP("SR62"),^TMP("SRAY"),^TMP("SRAN"),SRTN,SITE,SRCAR,SRCNS,SRDA,SRDEATH,SRDFN,SRY,SRN,SROC,SRRES,SRSDATE,SRTDT,SRDTHUR,SRMAJMIN,SRTEMP,SR14,CPT,SRCPT,SRZ,SRZZ,SRDIV,SRADMIT,SRADMT,SRATT,SRK,SRNODE,SRATTEND,SRPO,SRSUB,SRTMP
- +11 SET ZTREQ="@"
- +12 QUIT
- AQ ; set ready to transmit field to ready
- +1 NEW SRTD
- DO AQDT
- SET $PIECE(^SRF(SRTN,.4),"^",2)="R"
- SET ^SRF("AQ",SRTD,SRTN)=""
- +2 QUIT
- AQDT ; get quarterly transmission date for this case
- +1 NEW SRDAY,SRQTR,SRYR
- +2 SET SRYR=$EXTRACT(SRSDATE,1,3)
- SET SRDAY=$EXTRACT(SRSDATE,4,7)
- SET SRQTR=$SELECT(SRDAY<401:2,SRDAY<701:3,SRDAY<1001:4,1:1)
- IF SRQTR=1
- SET SRYR=SRYR+1
- +3 SET SRTD=SRYR_$SELECT(SRQTR=1:"0214",SRQTR=2:"0515",SRQTR=3:"0814",1:"1114")
- +4 QUIT
- PRE ; pre-install process for SR*3*62
- +1 NEW SRQOP,SRM,SRMQ
- +2 SET SRQOP=$ORDER(^DIC(19,"B","SRO QUARTERLY REPORT",0))
- SET SRM=$ORDER(^DIC(19,"B","SRO-CHIEF REPORTS",0))
- IF 'SRQOP!'SRM
- QUIT
- +3 SET SRMQ=$ORDER(^DIC(19,SRM,10,"B",SRQOP,0))
- IF 'SRMQ
- QUIT
- DO DIK
- +4 SET SRQM=$ORDER(^DIC(19,"B","SROQ MENU",0))
- IF 'SRQM
- QUIT
- SET SRMQ=$ORDER(^DIC(19,SRM,10,"B",SRQM,0))
- IF 'SRMQ
- QUIT
- DIK KILL DA,DIK
- SET DA(1)=SRM
- SET DA=SRMQ
- SET DIK="^DIC(19,"_DA(1)_",10,"
- DO ^DIK
- KILL DA,DIK
- +1 QUIT
