source: FOIAVistA/tag/r/SURGERY-SR/SR62UTL.m@ 628

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