source: WorldVistAEHR/trunk/r/SURGERY-SR/SR95UTL.m@ 1769

SR95UTL ;BIR/ADM-Utility routine for patch SR*3*95; [09/01/00  10:33 AM ]

 ;;3.0; Surgery ;**95**;24 Jun 93

 ;

 ; Reference to ^DGPM("APTT1" supported by DBIA #565

 ;

 Q

PRE ; pre-install action for SR*3*95

 ; add new entried to file 136.5

 S ^SRO(136.5,33,0)="TRACHEOSTOMY^^^Y",^SRO(136.5,33,1,0)="^^4^4^3000711^"

 S ^SRO(136.5,33,1,1,0)="This category should be selected if a procedure to cut into the trachea"

 S ^SRO(136.5,33,1,2,0)="and insert a tube to overcome tracheal obstruction, or to facilitate"

 S ^SRO(136.5,33,1,3,0)="extended mechanical ventilation, was performed during the postoperative"

 S ^SRO(136.5,33,1,4,0)="hospitalization."

 S ^SRO(136.5,34,0)="NEW MECHANICAL CIRCULATORY SUPPORT^^^Y"

 S ^SRO(136.5,34,1,0)="^^5^5^3000711^"

 S ^SRO(136.5,34,1,1,0)="This category should be selected if the patient left the operating suite"

 S ^SRO(136.5,34,1,2,0)="while dependent upon IABP or VAD for circulatory support postoperatively,"

 S ^SRO(136.5,34,1,3,0)="even if the pump is only used for a short time postoperatively.  However,"

 S ^SRO(136.5,34,1,4,0)="this category is only appropriate if the patient did not enter the OR"

 S ^SRO(136.5,34,1,5,0)="with mechanical circulatory support."

 S ^SRO(136.5,"B","TRACHEOSTOMY",33)=""

 S ^SRO(136.5,"B","NEW MECHANICAL CIRCULATORY SUP",34)=""

 S ^SRO(136.5,0)="PERIOPERATIVE OCCURRENCE CATEGORY^136.5I^34^34"

 ; add new entries to file 139.2

 I $G(^SRO(139.2,21,0))'="HDL" D

 .F DA=21,22,23,24 S DIK="^SRO(139.2," D ^DIK

 .S ^SRO(139.2,21,0)="HDL",^SRO(139.2,21,2)=72

 .S ^SRO(139.2,22,0)="TRIGLYCERIDE",^SRO(139.2,22,2)=72

 .S ^SRO(139.2,23,0)="LDL",^SRO(139.2,23,2)=72

 .S ^SRO(139.2,24,0)="CHOLESTEROL",^SRO(139.2,24,2)=72

 .S DIK="^SRO(139.2,",DIK(1)=".01" D ENALL^DIK K DA,DIK

LETR ; add text of 30-day letter to file 133

 N I,SRDIV,SRLINE,X S SRDIV=0 F  S SRDIV=$O(^SRO(133,SRDIV)) Q:'SRDIV  D

 .S ^SRO(133,SRDIV,5,0)="^133.031^40^40^3000818^^^^"

 .F I=1:1:40 S X=$T(DAY30+I),SRLINE=$P(X,";;",2) S ^SRO(133,SRDIV,5,I,0)=SRLINE

CLEAN ; delete file 132.8 if test site

 I $D(^SRO(132.8)) S DIU="^SRO(132.8,",DIU(0)="DT" D EN^DIU2

 Q

EN1 ; ASA Class conversion from set of codes to file

 S SRTN=0 F  S SRTN=$O(^SRF(SRTN)) Q:'SRTN  S (SRASA,SRNEW)=$P($G(^SRF(SRTN,1.1)),"^",3) I SRASA'="" D

 .I SRASA=1!(SRASA=2)!(SRASA=3)!(SRASA=4)!(SRASA=5) Q

 .I SRASA="1E" S SRNEW=7

 .I SRASA="2E" S SRNEW=8

 .I SRASA="3E" S SRNEW=9

 .I SRASA="4E" S SRNEW=10

 .I SRASA="5E" S SRNEW=11

 .I SRNEW'=SRASA S $P(^SRF(SRTN,1.1),"^",3)=SRNEW

 K SRASA,SRNEW,SRTN

MSG ; send mail message notification that conversion is completed

 S XMY(DUZ)="",XMSUB="SR*3*95 - ASA Class Conversion Completed"

 S SRTXT(1)="Surgery ASA Class conversion is completed."

 S XMDUZ=.5,XMTEXT="SRTXT("

 N I D ^XMD S ZTREQ="@"

 Q

QR ; transmit quarterly reports for FY2000

 S (SRFLG,SRT)=1 D NOW^%DTC S SRNOW=$E(%,1,12)

 S SRSTART=2991001,SREND=2991231 D TSK

 S SRSTART=3000101,SREND=3000331 D TSK

 S SRSTART=3000401,SREND=3000630 D TSK

 I DT>3001113 S SRSTART=3000701,SREND=3000930 D TSK

 S ZTREQ="@"

 Q

TSK S ZTDTH=SRNOW,ZTIO="",ZTDESC="Surgery Quarterly Report",(ZTSAVE("SRSTART"),ZTSAVE("SREND"),ZTSAVE("SRFLG"),ZTSAVE("SRT"))="",ZTRTN="EN^SROQT" D ^%ZTLOAD

 Q

POST ; post-install action for SR*3*95

 D NOW^%DTC S (SRNOW,ZTDTH)=$E(%,1,12),ZTRTN="EN1^SR95UTL",ZTDESC="Surgery ASA Class Conversion",ZTIO="" D ^%ZTLOAD

 D MES^XPDUTL("  ASA Class conversion process queued...")

 ;

 N SRD S SRD=^XMB("NETNAME") I SRD["TST."!(SRD["TEST")!(SRD["UTL.")!(SRD["TRAIN")!(SRD[".IHS.GOV")!(SRD["CPRS") Q

 S ZTDTH=SRNOW,ZTRTN="TN1^SR95UTL",ZTDESC="Surgery Risk Assessment Retransmission",ZTIO="" D ^%ZTLOAD

 S ZTDTH=SRNOW,ZTRTN="QR^SR95UTL",ZTDESC="Surgery Quarterly Report",ZTIO="" D ^%ZTLOAD

 K SRNOW

 Q

TN1 ; transmit historical data

 K ^TMP("SRA",$J) S SRASITE=+$P($$SITE^SROVAR,"^",3),SRACNT=1

 S SRADFN=0 F  S SRADFN=$O(^SRF("ARS","C","T",SRADFN)) Q:'SRADFN  S SRTN=0 F  S SRTN=$O(^SRF("ARS","C","T",SRADFN,SRTN)) Q:'SRTN  S ^TMP("SRA",$J,SRTN)=""

 S SRTN=0 F  S SRTN=$O(^TMP("SRA",$J,SRTN)) Q:'SRTN  D STUFF

 I SRACNT=1 G END

 D TMSG

END K ^TMP("SRA",$J),DA,DFN,I,ISC,NAME,SR,SRA,SRACNT,SRADFN,SRACE,SRASITE,SRD,SRSDATE,SRTN,X,XMSUB,XMTEXT,VA S ZTREQ="@"

 Q

STUFF ; stuff entries into ^TMP("SRA"

 S SR=^SRF(SRTN,0),SRA(208)=$G(^SRF(SRTN,208)),DFN=$P(SR,"^"),SRSDATE=$P(SR,"^",9) D DEM^VADPT

 N VAINDT,X,SRDISTYP,SRPTF,SRRES,SRICD9,SRPICD9,SRX,SRY

 S SRACE=$P(SRA(208),"^",10) I 'SRACE S SRX=$P(VADM(8),"^") I SRX K DA,DIC,DIQ,DR S DIC=10,DR=2,DA=SRX,DIQ="SRY",DIQ(0)="I" D EN^DIQ1 S SRACE=SRY(10,SRX,2,"I")

 S X=$P(SRA(208),"^",15) D:X="" DSCHG S VAINDT=X-.0001

 D INP^VADPT S SRPTF=VAIN(10)

 S SRRES="" D RPC^DGPTFAPI(.SRRES,SRPTF)

 S SRPICD9=$P($G(SRRES(1)),U,3)

 I '$D(SRRES(2)) S SRICD9="^^^^^^^^"

 E  S SRICD9="" F I=1:1:$L(SRRES(2),"^") S X=$P(SRRES(2),"^",I) D

 .I I=1 S SRICD9=X Q

 .S SRICD9=SRICD9_"^"_X

 S X=$$SITE^SROUTL0(SRTN),SRDIV=$S(X:$P(^SRO(133,X,0),"^"),1:""),SRP(3)=$S(SRDIV:$$GET1^DIQ(4,SRDIV,99),1:SRASITE)

 S X=$P($G(SRRES(1)),U)

 S SRDISTYP=$S(X="REGULAR":1,X="NBC OR WHILE ASIH":2,X="EXPIRATION 6 MONTH LIMIT":3,X="IRREGULAR":4,X="TRANSFER":5,X="DEATH WITH AUTOPSY":6,X="DEATH WITHOUT AUTOPSY":7,1:"")

 S ^TMP("SRA",$J,SRACNT)=SRASITE_"^"_SRTN_"^1^"_$E(SRSDATE,1,7)_"^"_VA("PID")_"^"_SRP(3)_"^^"_SRACE_"^"_SRPICD9_"^",SRACNT=SRACNT+1

 S ^TMP("SRA",$J,SRACNT)=SRASITE_"^"_SRTN_"^2^"_SRDISTYP_"^"_SRICD9_"^",SRACNT=SRACNT+1

 Q

DSCHG ; find discharge date

 S VAIP("D")=SRSDATE D IN5^VADPT

 I 'VAIP(13) S X1=$P($G(^SRF(SRTN,.2)),"^",12),X2=1 D C^%DTC S SR24=X,SRDT=$O(^DGPM("APTT1",DFN,SRSDATE)) G:'SRDT!(SRDT>SR24) NODS S VAIP("D")=SRDT D IN5^VADPT

 I VAIP(17) S X=$E($P(VAIP(17,1),"^"),1,12) Q

NODS S X=""

 Q

TMSG ; create mail message to Denver

 S ISC=0,NAME=$G(^XMB("NETNAME")) I NAME["FORUM"!(NAME["ISC-")!($E(NAME,1,3)="ISC")!(NAME["ISC.") S ISC=1

 I ISC S XMY("G.RISK ASSESSMENT@"_^XMB("NETNAME"))=""

 I 'ISC S (XMY("G.CARDIAC RISK ASSESSMENTS@DENVER.VA.GOV"),XMY("G.SRCARDIAC@ISC-CHICAGO.VA.GOV"))=""

 S SRD=^XMB("NETNAME") S XMSUB="** SR*3*95 FROM VAMC-"_SRASITE_" **",XMDUZ=$S($D(DUZ):DUZ,1:.5)

 S XMTEXT="^TMP(""SRA"",$J," N I D ^XMD

 Q

DAY30 ;;

 ;;One month ago, you had an operation at the VA Medical Center.  We are

 ;;interested in how you feel.  Have you had any health problems since your

 ;;operation ?  We would like to hear from you.  Please take a few minutes

 ;;to answer these questions and return this letter in the self-addressed

 ;;stamped envelope.

 ;; 

 ;;Have you been to a hospital or seen a doctor for any reason since your

 ;;operation ?   ___ Yes  ___ No

 ;; 

 ;;If you answered NO, you do not need to answer any more questions.  Please

 ;;return this sheet in the self-addressed stamped envelope.

 ;; 

 ;;If you have answered YES, please answer the following questions.

 ;; 

 ;;   1) Have you been seen in an outpatient clinic or doctor's office ? 

 ;;      ___ Yes  ___ No

 ;; 

 ;;      Why did you go to the clinic or doctor's office ? ________________

 ;; 

 ;;      Where ? (name and location) _____________________  Date ? ________

 ;; 

 ;;      Who was your doctor ? ____________________________________________

 ;; 

 ;; 

 ;;   2) Were you admitted to a hospital ?  ___ Yes  ___ No

 ;; 

 ;;      Why did you go to the hospital ? _________________________________

 ;; 

 ;;      Where ? (name and location) _____________________  Date ? ________

 ;; 

 ;;      Who was your doctor ? ____________________________________________

 ;; 

 ;; 

 ;;Please return this letter whether or not you have had any medical

 ;;problems.  Your health and opinion are important to us.  Thank You.

 ;; 

 ;;Sincerely,

 ;; 

 ;; 

 ;;Surgical Clinical Nurse Reviewer