- SR81UTL ;BIR/ADM-SR*3*81 Retransmissions of FY98 data ; [ 10/06/98 1:04 PM ]
- ;;3.0; Surgery ;**81**;24 Jun 93
- ; SRP(1) - station number
- ; SRP(2) - assessment/case number
- ; SRP(3) - division
- ; SRP(4) - patient ID
- ; SRP(5) - date of operation
- ; SRP(6) - hospital admission date
- ; SRP(7) - hospital discharge date
- ; SRP(8) - admission/transfer to surgical service
- ; SRP(9) - transfer/discharge to non-acute care
- ; SRP(10) - date/time patient left the OR
- ; SRP(11) - anesthesia care start date/time
- ; SRP(12) - PACU discharge date/time
- ; SRP(13) - observation admission date/time
- ; SRP(14) - observation discharge date/time
- ; SRP(15) - observation treating specialty
- ; SRP(16) - concurrent case number
- Q
- EN1 K ^TMP("SRA",$J),^TMP("SRAINC",$J) S SITE=+$P($$SITE^SROVAR,"^",3),(SRI,SRAINC)=0,SROPD=2971000
- F S SROPD=$O(^SRF("AC",SROPD)) Q:'SROPD S SRTN=0 F S SRTN=$O(^SRF("AC",SROPD,SRTN)) Q:'SRTN S SRA=$G(^SRF(SRTN,"RA")),SR235=$P(SRA,"^") I (SR235="T"!(SR235="C")),$P(SRA,"^",6)="Y",$P(SRA,"^",2)="N",$G(^SRF(SRTN,208.1))="" D
- .K SRP F I=1:1:16 S SRP(I)=""
- .S SRA=$G(^SRF(SRTN,0)) Q:SRA="" S SRP(1)=SITE,SRP(2)=SRTN,DFN=$P(SRA,"^"),SRP(5)=$P(SRA,"^",9) D DEM^VADPT S SRP(4)=VA("PID")
- .I $P($G(^SRF(SRTN,208.1)),"^")="" D OBS D:'SRSOUT NA I SRSOUT D INC Q
- .I SR235="C" Q
- .S SRP(3)=$P($G(^SRF(SRTN,8)),"^") I SRP(3) S SRP(3)=$$GET1^DIQ(4,SRP(3),99)
- .S SRA=$G(^SRF(SRTN,208)) F I=14:1:17 S SRP(I-8)=$E($P(SRA,"^",I),1,12)
- .S SRA=$G(^SRF(SRTN,.2)) S SRP(10)=$P(SRA,"^",12),SRP(11)=$P(SRA,"^")
- .S SRP(12)=$P($G(^SRF(SRTN,1.1)),"^",8),SRA=$G(^SRF(SRTN,208.1)),J=0 F I=13:1:15 S J=J+1,SRP(I)=$P(SRA,"^",J)
- .S SRP(16)=$P($G(^SRF(SRTN,"CON")),"^")
- .S SRTMP=SRP(1) F I=2:1:16 S SRTMP=SRTMP_"^"_SRP(I)
- .S SRI=SRI+1,^TMP("SRA",$J,SRI)=SRTMP
- N SRD S SRD=^XMB("NETNAME") I $E(SRD,1,3)="ISC"!(SRD["ISC-")!(SRD["ISC.")!(SRD["FORUM")!(SRD["TST.")!(SRD["TEST")!(SRD["UTL.")!(SRD["TRN.") G RAMG
- S XMSUB="** SR*3*81 FROM VAMC-"_SITE_" **",XMDUZ=$S($D(DUZ):DUZ,1:.5)
- S XMY("G.SRCOSERV@ISC-CHICAGO.DOMAIN.EXT")=""
- S XMTEXT="^TMP(""SRA"",$J," N I D ^XMD
- RAMG ; send list of assessments changed to incomplete
- G:SRAINC=0 END K XMTEXT,XMSUB,XMDUZ
- S ^TMP("SRAINC",$J,.1)="The following completed/transmitted non-cardiac assessments have been",^TMP("SRAINC",$J,.2)="updated to incomplete. Please review patient demographic information and"
- S ^TMP("SRAINC",$J,.3)="complete these assessments again.",^TMP("SRAINC",$J,.4)=""
- S XMSUB="ASSESSMENTS CHANGED TO INCOMPLETE",XMDUZ=$S($D(DUZ):DUZ,1:.5)
- S XMY("G.RISK ASSESSMENT")=""
- S XMTEXT="^TMP(""SRAINC"",$J," N I D ^XMD
- END K ^TMP("SRA",$J),^TMP("SRAINC",$J) S ZTREQ="@"
- Q
- OBS ; check for admission for observation following surgery
- S SRSOUT=0,(VAIP("D"),SRSDATE)=SRP(5) D IN5^VADPT I VAIP(13) Q
- S X1=$P($G(^SRF(SRTN,.2)),"^",12),X2=1 D C^%DTC S SR24=X,SRDT=$O(^DGPM("APTT1",DFN,SRP(5))) Q:'SRDT!(SRDT>SR24) S VAIP("D")=SRDT D IN5^VADPT I 'VAIP(13) Q
- S SRX=$P(VAIP(13,6),"^") D SPEC S Y="18,23,24,36,41,65,94" I Y[SRSP S SRSOUT=1
- Q
- NA F I=1:1:3 S $P(^SRF(SRTN,208.1),"^",I)="NA"
- Q
- SPEC K DA,DIC,DIQ,DR,SRY S DIC=45.7,DR=1,DA=SRX,DIQ="SRY",DIQ(0)="I" D EN^DIQ1 S SRSP=SRY(45.7,SRX,1,"I") I SRSP,$L(SRSP)=1 S SRSP="0"_SRSP
- Q
- INC ; make completed/transmitted assessment incomplete
- K DA,DIE,DR S DIE=130,DA=SRTN,DR="235////I;393////"_$S(SR235="T":1,1:"") D ^DIE K DA,DIE,DR
- I SR235="C"&($P(^SRF(SRTN,"RA"),"^",3)'="1") S DIE=130,DA=SRTN,DR="272///@" D ^DIE K DA,DIE,DR
- S X=SRP(5),SRADT=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
- S SRAINC=SRAINC+1,^TMP("SRAINC",$J,SRAINC)="ASSESSMENT: "_SRTN_" "_$J(VADM(1),20)_" OPERATION DATE: "_SRADT
- Q
- POST ; post-install action for SR*3*81
- ; task retransmission message
- D NOW^%DTC S ZTDTH=$E(%,1,12),ZTRTN="EN1^SR81UTL",ZTDESC="Surgery Risk Assessment Retransmission",ZTIO="" D ^%ZTLOAD
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSR81UTL 3864 printed Feb 19, 2025@00:05:24 Page 2
- SR81UTL ;BIR/ADM-SR*3*81 Retransmissions of FY98 data ; [ 10/06/98 1:04 PM ]
- +1 ;;3.0; Surgery ;**81**;24 Jun 93
- +2 ; SRP(1) - station number
- +3 ; SRP(2) - assessment/case number
- +4 ; SRP(3) - division
- +5 ; SRP(4) - patient ID
- +6 ; SRP(5) - date of operation
- +7 ; SRP(6) - hospital admission date
- +8 ; SRP(7) - hospital discharge date
- +9 ; SRP(8) - admission/transfer to surgical service
- +10 ; SRP(9) - transfer/discharge to non-acute care
- +11 ; SRP(10) - date/time patient left the OR
- +12 ; SRP(11) - anesthesia care start date/time
- +13 ; SRP(12) - PACU discharge date/time
- +14 ; SRP(13) - observation admission date/time
- +15 ; SRP(14) - observation discharge date/time
- +16 ; SRP(15) - observation treating specialty
- +17 ; SRP(16) - concurrent case number
- +18 QUIT
- EN1 KILL ^TMP("SRA",$JOB),^TMP("SRAINC",$JOB)
- SET SITE=+$PIECE($$SITE^SROVAR,"^",3)
- SET (SRI,SRAINC)=0
- SET SROPD=2971000
- +1 FOR
- SET SROPD=$ORDER(^SRF("AC",SROPD))
- if 'SROPD
- QUIT
- SET SRTN=0
- FOR
- SET SRTN=$ORDER(^SRF("AC",SROPD,SRTN))
- if 'SRTN
- QUIT
- SET SRA=$GET(^SRF(SRTN,"RA"))
- SET SR235=$PIECE(SRA,"^")
- IF (SR235="T"!(SR235="C"))
- IF $PIECE(SRA,"^",6)="Y"
- IF $PIECE(SRA,"^",2)="N"
- IF $GET(^SRF(SRTN,208.1))=""
- Begin DoDot:1
- +2 KILL SRP
- FOR I=1:1:16
- SET SRP(I)=""
- +3 SET SRA=$GET(^SRF(SRTN,0))
- if SRA=""
- QUIT
- SET SRP(1)=SITE
- SET SRP(2)=SRTN
- SET DFN=$PIECE(SRA,"^")
- SET SRP(5)=$PIECE(SRA,"^",9)
- DO DEM^VADPT
- SET SRP(4)=VA("PID")
- +4 IF $PIECE($GET(^SRF(SRTN,208.1)),"^")=""
- DO OBS
- if 'SRSOUT
- DO NA
- IF SRSOUT
- DO INC
- QUIT
- +5 IF SR235="C"
- QUIT
- +6 SET SRP(3)=$PIECE($GET(^SRF(SRTN,8)),"^")
- IF SRP(3)
- SET SRP(3)=$$GET1^DIQ(4,SRP(3),99)
- +7 SET SRA=$GET(^SRF(SRTN,208))
- FOR I=14:1:17
- SET SRP(I-8)=$EXTRACT($PIECE(SRA,"^",I),1,12)
- +8 SET SRA=$GET(^SRF(SRTN,.2))
- SET SRP(10)=$PIECE(SRA,"^",12)
- SET SRP(11)=$PIECE(SRA,"^")
- +9 SET SRP(12)=$PIECE($GET(^SRF(SRTN,1.1)),"^",8)
- SET SRA=$GET(^SRF(SRTN,208.1))
- SET J=0
- FOR I=13:1:15
- SET J=J+1
- SET SRP(I)=$PIECE(SRA,"^",J)
- +10 SET SRP(16)=$PIECE($GET(^SRF(SRTN,"CON")),"^")
- +11 SET SRTMP=SRP(1)
- FOR I=2:1:16
- SET SRTMP=SRTMP_"^"_SRP(I)
- +12 SET SRI=SRI+1
- SET ^TMP("SRA",$JOB,SRI)=SRTMP
- End DoDot:1
- +13 NEW SRD
- SET SRD=^XMB("NETNAME")
- IF $EXTRACT(SRD,1,3)="ISC"!(SRD["ISC-")!(SRD["ISC.")!(SRD["FORUM")!(SRD["TST.")!(SRD["TEST")!(SRD["UTL.")!(SRD["TRN.")
- GOTO RAMG
- +14 SET XMSUB="** SR*3*81 FROM VAMC-"_SITE_" **"
- SET XMDUZ=$SELECT($DATA(DUZ):DUZ,1:.5)
- +15 SET XMY("G.SRCOSERV@ISC-CHICAGO.DOMAIN.EXT")=""
- +16 SET XMTEXT="^TMP(""SRA"",$J,"
- NEW I
- DO ^XMD
- RAMG ; send list of assessments changed to incomplete
- +1 if SRAINC=0
- GOTO END
- KILL XMTEXT,XMSUB,XMDUZ
- +2 SET ^TMP("SRAINC",$JOB,.1)="The following completed/transmitted non-cardiac assessments have been"
- SET ^TMP("SRAINC",$JOB,.2)="updated to incomplete. Please review patient demographic information and"
- +3 SET ^TMP("SRAINC",$JOB,.3)="complete these assessments again."
- SET ^TMP("SRAINC",$JOB,.4)=""
- +4 SET XMSUB="ASSESSMENTS CHANGED TO INCOMPLETE"
- SET XMDUZ=$SELECT($DATA(DUZ):DUZ,1:.5)
- +5 SET XMY("G.RISK ASSESSMENT")=""
- +6 SET XMTEXT="^TMP(""SRAINC"",$J,"
- NEW I
- DO ^XMD
- END KILL ^TMP("SRA",$JOB),^TMP("SRAINC",$JOB)
- SET ZTREQ="@"
- +1 QUIT
- OBS ; check for admission for observation following surgery
- +1 SET SRSOUT=0
- SET (VAIP("D"),SRSDATE)=SRP(5)
- DO IN5^VADPT
- IF VAIP(13)
- QUIT
- +2 SET X1=$PIECE($GET(^SRF(SRTN,.2)),"^",12)
- SET X2=1
- DO C^%DTC
- SET SR24=X
- SET SRDT=$ORDER(^DGPM("APTT1",DFN,SRP(5)))
- if 'SRDT!(SRDT>SR24)
- QUIT
- SET VAIP("D")=SRDT
- DO IN5^VADPT
- IF 'VAIP(13)
- QUIT
- +3 SET SRX=$PIECE(VAIP(13,6),"^")
- DO SPEC
- SET Y="18,23,24,36,41,65,94"
- IF Y[SRSP
- SET SRSOUT=1
- +4 QUIT
- NA FOR I=1:1:3
- SET $PIECE(^SRF(SRTN,208.1),"^",I)="NA"
- +1 QUIT
- SPEC KILL DA,DIC,DIQ,DR,SRY
- SET DIC=45.7
- SET DR=1
- SET DA=SRX
- SET DIQ="SRY"
- SET DIQ(0)="I"
- DO EN^DIQ1
- SET SRSP=SRY(45.7,SRX,1,"I")
- IF SRSP
- IF $LENGTH(SRSP)=1
- SET SRSP="0"_SRSP
- +1 QUIT
- INC ; make completed/transmitted assessment incomplete
- +1 KILL DA,DIE,DR
- SET DIE=130
- SET DA=SRTN
- SET DR="235////I;393////"_$SELECT(SR235="T":1,1:"")
- DO ^DIE
- KILL DA,DIE,DR
- +2 IF SR235="C"&($PIECE(^SRF(SRTN,"RA"),"^",3)'="1")
- SET DIE=130
- SET DA=SRTN
- SET DR="272///@"
- DO ^DIE
- KILL DA,DIE,DR
- +3 SET X=SRP(5)
- SET SRADT=$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3)
- +4 SET SRAINC=SRAINC+1
- SET ^TMP("SRAINC",$JOB,SRAINC)="ASSESSMENT: "_SRTN_" "_$JUSTIFY(VADM(1),20)_" OPERATION DATE: "_SRADT
- +5 QUIT
- POST ; post-install action for SR*3*81
- +1 ; task retransmission message
- +2 DO NOW^%DTC
- SET ZTDTH=$EXTRACT(%,1,12)
- SET ZTRTN="EN1^SR81UTL"
- SET ZTDESC="Surgery Risk Assessment Retransmission"
- SET ZTIO=""
- DO ^%ZTLOAD
- +3 QUIT