Released SR*3*162 SEQ #159 Extracted from mail message **KIDS**:SR*3.0*162^ **INSTALL NAME** SR*3.0*162 "BLD",6590,0) SR*3.0*162^SURGERY^0^3080318^y "BLD",6590,1,0) ^^1^1^3071023^ "BLD",6590,1,1,0) Correct multiple Surgery tickets "BLD",6590,4,0) ^9.64PA^^ "BLD",6590,6.3) 4 "BLD",6590,"ABPKG") n "BLD",6590,"KRN",0) ^9.67PA^8989.52^19 "BLD",6590,"KRN",.4,0) .4 "BLD",6590,"KRN",.401,0) .401 "BLD",6590,"KRN",.402,0) .402 "BLD",6590,"KRN",.403,0) .403 "BLD",6590,"KRN",.5,0) .5 "BLD",6590,"KRN",.84,0) .84 "BLD",6590,"KRN",3.6,0) 3.6 "BLD",6590,"KRN",3.8,0) 3.8 "BLD",6590,"KRN",9.2,0) 9.2 "BLD",6590,"KRN",9.8,0) 9.8 "BLD",6590,"KRN",9.8,"NM",0) ^9.68A^3^3 "BLD",6590,"KRN",9.8,"NM",1,0) SROESPR1^^0^B65495045 "BLD",6590,"KRN",9.8,"NM",2,0) SROGMTS^^0^B59971824 "BLD",6590,"KRN",9.8,"NM",3,0) SROWL^^0^B27493770 "BLD",6590,"KRN",9.8,"NM","B","SROESPR1",1) "BLD",6590,"KRN",9.8,"NM","B","SROGMTS",2) "BLD",6590,"KRN",9.8,"NM","B","SROWL",3) "BLD",6590,"KRN",19,0) 19 "BLD",6590,"KRN",19.1,0) 19.1 "BLD",6590,"KRN",101,0) 101 "BLD",6590,"KRN",409.61,0) 409.61 "BLD",6590,"KRN",771,0) 771 "BLD",6590,"KRN",870,0) 870 "BLD",6590,"KRN",8989.51,0) 8989.51 "BLD",6590,"KRN",8989.52,0) 8989.52 "BLD",6590,"KRN",8994,0) 8994 "BLD",6590,"KRN","B",.4,.4) "BLD",6590,"KRN","B",.401,.401) "BLD",6590,"KRN","B",.402,.402) "BLD",6590,"KRN","B",.403,.403) "BLD",6590,"KRN","B",.5,.5) "BLD",6590,"KRN","B",.84,.84) "BLD",6590,"KRN","B",3.6,3.6) "BLD",6590,"KRN","B",3.8,3.8) "BLD",6590,"KRN","B",9.2,9.2) "BLD",6590,"KRN","B",9.8,9.8) "BLD",6590,"KRN","B",19,19) "BLD",6590,"KRN","B",19.1,19.1) "BLD",6590,"KRN","B",101,101) "BLD",6590,"KRN","B",409.61,409.61) "BLD",6590,"KRN","B",771,771) "BLD",6590,"KRN","B",870,870) "BLD",6590,"KRN","B",8989.51,8989.51) "BLD",6590,"KRN","B",8989.52,8989.52) "BLD",6590,"KRN","B",8994,8994) "BLD",6590,"QUES",0) ^9.62^^ "BLD",6590,"REQB",0) ^9.611^3^3 "BLD",6590,"REQB",1,0) SR*3.0*119^2 "BLD",6590,"REQB",2,0) SR*3.0*127^2 "BLD",6590,"REQB",3,0) SR*3.0*128^2 "BLD",6590,"REQB","B","SR*3.0*119",1) "BLD",6590,"REQB","B","SR*3.0*127",2) "BLD",6590,"REQB","B","SR*3.0*128",3) "MBREQ") 0 "PKG",167,-1) 1^1 "PKG",167,0) SURGERY^SR^SURGICAL DATA COLLECTION AND OPERATIONS SCHEDULING "PKG",167,20,0) ^9.402P^^ "PKG",167,22,0) ^9.49I^1^1 "PKG",167,22,1,0) 3.0^2930624^2930811 "PKG",167,22,1,"PAH",1,0) 162^3080318 "PKG",167,22,1,"PAH",1,1,0) ^^1^1^3080318 "PKG",167,22,1,"PAH",1,1,1,0) Correct multiple Surgery tickets "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") NO "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 3 "RTN","SROESPR1") 0^1^B65495045^B64764154 "RTN","SROESPR1",1,0) SROESPR1 ;BIR/ADM - SURGERY E-SIG UTILITY ; [ 04/21/04 12:08 PM ] "RTN","SROESPR1",2,0) ;;3.0; Surgery ;**100,128,162**;24 Jun 93;Build 4 "RTN","SROESPR1",3,0) ; "RTN","SROESPR1",4,0) ;** NOTICE: This routine is part of an implementation of a nationally "RTN","SROESPR1",5,0) ;** controlled procedure. Local modifications to this routine "RTN","SROESPR1",6,0) ;** are prohibited. "RTN","SROESPR1",7,0) ; "RTN","SROESPR1",8,0) ; Reference to EXTRACT^TIULQ supported by DBIA #2693 "RTN","SROESPR1",9,0) ; "RTN","SROESPR1",10,0) ; This routine was cloned in part or in whole from TIUPRPN1. "RTN","SROESPR1",11,0) PRINT(SRFLAG,SRSPG) ; Print Summary "RTN","SROESPR1",12,0) ; ^TMP("SRPR",$J) is array of records passed by reference "RTN","SROESPR1",13,0) ; SRFLAG=1 --> Chart Copy SRSPG=1 --> Contiguous "RTN","SROESPR1",14,0) ; SRFLAG=0 --> Work Copy SRSPG=0 --> Fresh Page- each note "RTN","SROESPR1",15,0) N SRI,SRJ,SRPAGE,SRFOOT,SRK,SRDA,SRCONT,SRPGRP,SRTYP "RTN","SROESPR1",16,0) N SRPFHDR,SRPFNBR,SROPAGE "RTN","SROESPR1",17,0) S SRFLAG=+$G(SRFLAG),SRSPG=+$G(SRSPG) "RTN","SROESPR1",18,0) S SRI=0 F S SRI=$O(^TMP("SRPR",$J,SRI)) Q:SRI="" D Q:'SRCONT "RTN","SROESPR1",19,0) . N DFN,SR,SRERR "RTN","SROESPR1",20,0) . I SRI["$" S SRPGRP=$P(SRI,"$"),SRPFHDR=$P($P(SRI,";"),"$",2) "RTN","SROESPR1",21,0) . E S SRPFHDR="Surgery Reports" "RTN","SROESPR1",22,0) . I $G(SRPGRP)'=2 S SRSPG=0 "RTN","SROESPR1",23,0) . S DFN=$P(SRI,";",2) "RTN","SROESPR1",24,0) . D PAT^SROESPR(.SRFOOT,DFN) "RTN","SROESPR1",25,0) . I +$G(SRSPG) D HEADER^SROESPR2(.SRFOOT,SRFLAG,.SRPFHDR) "RTN","SROESPR1",26,0) . S SRJ=0 F S SRJ=$O(^TMP("SRPR",$J,SRI,SRJ)) Q:'SRJ D Q:'SRCONT "RTN","SROESPR1",27,0) . . S SRK=0 F S SRK=$O(^TMP("SRPR",$J,SRI,SRJ,SRK)) Q:'SRK D Q:'+$G(SRCONT) "RTN","SROESPR1",28,0) . . . N SRERR1,SRW K SRCONT1 S SRPFNBR=^(SRK) "RTN","SROESPR1",29,0) . . . ; If the document has been deleted, QUIT "RTN","SROESPR1",30,0) . . . D EXTRACT^TIULQ(SRK,"SRW",.SRERR1,".01") I $P($G(SRERR1),"^")=1 S SRCONT=1 Q "RTN","SROESPR1",31,0) . . . I '+$G(SRSPG) D HEADER^SROESPR2(.SRFOOT,SRFLAG,.SRPFHDR) "RTN","SROESPR1",32,0) . . . S SRDA=SRK "RTN","SROESPR1",33,0) . . . D REPORT(SRDA) Q:'+$G(SRCONT) "RTN","SROESPR1",34,0) . . . I '+$G(SRSPG) K SRCONT1 D SETCONT(1) "RTN","SROESPR1",35,0) . . . I $E(IOST)="C",'$O(^TMP("SRPR",$J,SRI,SRJ,SRK)) S SRCONT=0 "RTN","SROESPR1",36,0) . Q:'SRCONT I $E(IOST)="C" S SRCONT=$$STOP^SROESPR2() Q:'SRCONT "RTN","SROESPR1",37,0) . I +$G(SRSPG),$E(IOST)'="C" K SRCONT1 D SETCONT(1) "RTN","SROESPR1",38,0) Q "RTN","SROESPR1",39,0) REPORT(SRDA) ; Report Text "RTN","SROESPR1",40,0) N DIW,DIWF,DIWL,DIWR,DIWT,SRERR,SR,SRI,SRLINE,X,Z,SRY,LOC "RTN","SROESPR1",41,0) K ^TMP("SRLQ",$J) "RTN","SROESPR1",42,0) S SRLINE=0 "RTN","SROESPR1",43,0) D EXTRACT^TIULQ(+SRDA,"^TMP(""SRLQ"",$J)",.SRERR,"",SRLINE,1) "RTN","SROESPR1",44,0) I +$G(SRERR) W !,$P(SRERR,U,2) Q "RTN","SROESPR1",45,0) Q:'$D(^TMP("SRLQ",$J)) "RTN","SROESPR1",46,0) S SRY=4,SRCONT=1 "RTN","SROESPR1",47,0) D SETCONT() Q:'SRCONT "RTN","SROESPR1",48,0) W "NOTE DATED: " "RTN","SROESPR1",49,0) W $$DATE^SROESPR(^TMP("SRLQ",$J,SRDA,1301,"I"),"MM/DD/CCYY HR:MIN") "RTN","SROESPR1",50,0) W ?30,$$UP^XLFSTR(^TMP("SRLQ",$J,SRDA,.01,"E")),! "RTN","SROESPR1",51,0) I +$G(^TMP("SRLQ",$J,SRDA,1205,"I")) D "RTN","SROESPR1",52,0) .S LOC=$G(^TMP("SRLQ",$J,SRDA,1205,"I")) Q:'$D(^SC(LOC,0)) "RTN","SROESPR1",53,0) .W $S($P(^SC(LOC,0),U,3)="W":"ADMITTED: ",1:"VISIT: ") "RTN","SROESPR1",54,0) .W $$DATE^SROESPR(^TMP("SRLQ",$J,SRDA,.07,"I"),"MM/DD/CCYY HR:MIN") "RTN","SROESPR1",55,0) .W " ",$G(^TMP("SRLQ",$J,SRDA,1205,"E")) "RTN","SROESPR1",56,0) I ^TMP("SRLQ",$J,SRDA,1701,"E")]"" W !,"SUBJECT: ",^("E"),! "RTN","SROESPR1",57,0) S SRCONT1=1 "RTN","SROESPR1",58,0) I $D(^TMP("SRLQ",$J,SRDA,"PROBLEM")) D Q:'SRCONT "RTN","SROESPR1",59,0) .D SETCONT() Q:'SRCONT "RTN","SROESPR1",60,0) .W !,"ASSOCIATED PROBLEMS:" "RTN","SROESPR1",61,0) .N SRI S SRI=0 "RTN","SROESPR1",62,0) .F S SRI=$O(^TMP("SRLQ",$J,SRDA,"PROBLEM",SRI)) Q:'SRI D Q:'SRCONT "RTN","SROESPR1",63,0) ..W !,^(SRI,0) "RTN","SROESPR1",64,0) ..D SETCONT() Q:'SRCONT "RTN","SROESPR1",65,0) W ! "RTN","SROESPR1",66,0) ; "RTN","SROESPR1",67,0) S SRI=0,DIWF="WN",DIWL=1,DIWR=79 K ^UTILITY($J,"W") "RTN","SROESPR1",68,0) F S SRI=$O(^TMP("SRLQ",$J,SRDA,"TEXT",SRI)) Q:SRI'>0 D Q:'SRCONT ; D ^DIWW "RTN","SROESPR1",69,0) . D SETCONT() Q:'SRCONT "RTN","SROESPR1",70,0) . S X=^TMP("SRLQ",$J,SRDA,"TEXT",SRI,0) S:X="" X=" " D ^DIWP "RTN","SROESPR1",71,0) D ^DIWW K ^UTILITY($J,"W") "RTN","SROESPR1",72,0) Q:'SRCONT "RTN","SROESPR1",73,0) RPTSIG ; Signature should be on bottom of form, Addenda on Subsequent pages "RTN","SROESPR1",74,0) N AUTHOR,EXPSIGNR,EXPCOSNR,SIGNDATE,SIGNEDBY,SIGNNAME,SIGTITL,SIGNMODE "RTN","SROESPR1",75,0) N COSGDATE,COSGEDBY,COSGNAME,COSGTITL,COSGMODE,SIGCHRT,COSCHRT,SRLINE "RTN","SROESPR1",76,0) S $P(SRLINE,"-",81)="" "RTN","SROESPR1",77,0) S AUTHOR=$G(^TMP("SRLQ",$J,SRDA,1202,"I"))_";"_$G(^("E")) "RTN","SROESPR1",78,0) S EXPSIGNR=$G(^TMP("SRLQ",$J,SRDA,1204,"I"))_";"_$G(^("E")) "RTN","SROESPR1",79,0) S EXPCOSNR=$G(^TMP("SRLQ",$J,SRDA,1208,"I"))_";"_$G(^("E")) "RTN","SROESPR1",80,0) S SIGNDATE=$G(^TMP("SRLQ",$J,SRDA,1501,"I")) "RTN","SROESPR1",81,0) S SIGNEDBY=$G(^TMP("SRLQ",$J,SRDA,1502,"I"))_";"_$G(^("E")) "RTN","SROESPR1",82,0) S SIGNNAME=$G(^TMP("SRLQ",$J,SRDA,1503,"E")) "RTN","SROESPR1",83,0) S SIGTITL=$G(^TMP("SRLQ",$J,SRDA,1504,"E")) "RTN","SROESPR1",84,0) S SIGNMODE=$G(^TMP("SRLQ",$J,SRDA,1505,"I"))_";"_$G(^("E")) "RTN","SROESPR1",85,0) S COSGDATE=$G(^TMP("SRLQ",$J,SRDA,1507,"I")) "RTN","SROESPR1",86,0) S COSGEDBY=$G(^TMP("SRLQ",$J,SRDA,1508,"I"))_";"_$G(^("E")) "RTN","SROESPR1",87,0) S COSGNAME=$G(^TMP("SRLQ",$J,SRDA,1509,"E")) "RTN","SROESPR1",88,0) S COSGTITL=$G(^TMP("SRLQ",$J,SRDA,1510,"E")) "RTN","SROESPR1",89,0) S COSGMODE=$G(^TMP("SRLQ",$J,SRDA,1511,"I"))_";"_$G(^("E")) "RTN","SROESPR1",90,0) S SIGCHRT=$G(^TMP("SRLQ",$J,SRDA,1512,"I"))_";"_$G(^("E")) "RTN","SROESPR1",91,0) S COSCHRT=$G(^TMP("SRLQ",$J,SRDA,1513,"I"))_";"_$G(^("E")) "RTN","SROESPR1",92,0) D SETCONT() Q:'SRCONT W ! "RTN","SROESPR1",93,0) D SIGBLK Q:'SRCONT "RTN","SROESPR1",94,0) ADDENDA ; Surgery Reports Addenda "RTN","SROESPR1",95,0) N DIW,DIWF,DIWL,DIWR,DIWT,X,Z,SRI,SRADD "RTN","SROESPR1",96,0) S SRADD=0,DIWF="WN",DIWL=1,DIWR=79 K ^UTILITY($J,"W") "RTN","SROESPR1",97,0) F S SRADD=$O(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD)) Q:SRADD'>0 D Q:'SRCONT "RTN","SROESPR1",98,0) . S SRY=4 D SETCONT() Q:'SRCONT "RTN","SROESPR1",99,0) . W !!,$$DATE^SROESPR(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1301,"I"),"MM/DD/CCYY HR:MIN"),?21,"ADDENDUM" "RTN","SROESPR1",100,0) . W ?41,"STATUS: ",^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,.05,"E") "RTN","SROESPR1",101,0) . S SRI=0 "RTN","SROESPR1",102,0) . F S SRI=$O(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,"TEXT",SRI)) Q:SRI'>0 D Q:'SRCONT "RTN","SROESPR1",103,0) . . D SETCONT() Q:'SRCONT "RTN","SROESPR1",104,0) . . S X=^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,"TEXT",SRI,0) S:X="" X=" " D ^DIWP "RTN","SROESPR1",105,0) . D ^DIWW "RTN","SROESPR1",106,0) . D:SRCONT ADDENSIG "RTN","SROESPR1",107,0) K ^UTILITY($J,"W") "RTN","SROESPR1",108,0) ; Write 2 linefeeds between records "RTN","SROESPR1",109,0) Q:'SRCONT W !! "RTN","SROESPR1",110,0) Q "RTN","SROESPR1",111,0) ADDENSIG ; "RTN","SROESPR1",112,0) N AUTHOR,EXPSIGNR,ATTNDING,SIGNDATE,SIGNEDBY,SIGNNAME,SIGNMODE "RTN","SROESPR1",113,0) N COSGDATE,COSGEDBY,COSGNAME,COSGMODE,SRLINE S $P(SRLINE,"-",80)="" "RTN","SROESPR1",114,0) S AUTHOR=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1202,"I"))_";"_$G(^("E")) "RTN","SROESPR1",115,0) S EXPSIGNR=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1204,"I"))_";"_$G(^("E")) "RTN","SROESPR1",116,0) S ATTNDING=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1209,"I"))_";"_$G(^("E")) "RTN","SROESPR1",117,0) S SIGNDATE=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1501,"I")) "RTN","SROESPR1",118,0) S SIGNEDBY=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1502,"I"))_";"_$G(^("E")) "RTN","SROESPR1",119,0) S SIGNNAME=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1503,"E")) "RTN","SROESPR1",120,0) S SIGTITL=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1504,"E")) "RTN","SROESPR1",121,0) S SIGNMODE=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1505,"I"))_";"_$G(^("E")) "RTN","SROESPR1",122,0) S COSGDATE=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1507,"I")) "RTN","SROESPR1",123,0) S COSGEDBY=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1508,"I"))_";"_$G(^("E")) "RTN","SROESPR1",124,0) S COSGNAME=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1509,"E")) "RTN","SROESPR1",125,0) S COSGTITL=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1510,"E")) "RTN","SROESPR1",126,0) S COSGMODE=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1511,"I"))_";"_$G(^("E")) "RTN","SROESPR1",127,0) S SRY=11 "RTN","SROESPR1",128,0) SIGBLK N SRGROOT S SRGROOT=$NA(^TMP("SRLQ",$J,SRDA)) "RTN","SROESPR1",129,0) I '+SIGNDATE D D SETCONT() Q:'SRCONT "RTN","SROESPR1",130,0) .I $$STATUS^SROESUTL(SRDA)'=7 W !,"**DRAFT COPY - DRAFT COPY -- ABOVE NOTE IS UNSIGNED-- DRAFT COPY - DRAFT COPY**" "RTN","SROESPR1",131,0) I SIGNEDBY]"",(+SIGNEDBY'=+AUTHOR) D "RTN","SROESPR1",132,0) . W ?21,"Author: ",$P(AUTHOR,";",2),! "RTN","SROESPR1",133,0) I +SIGNDATE D SETCONT() Q:'SRCONT D "RTN","SROESPR1",134,0) . W ?18,"Signed by:",$S($P(SIGNMODE,";")="C":" /s/ ",1:" /es/ "),?34,$S(SIGNNAME]"":SIGNNAME,1:$P(SIGNEDBY,";",2)) "RTN","SROESPR1",135,0) . W !?34,SIGTITL "RTN","SROESPR1",136,0) . I $L(SIGTITL)>30 W !?34 "RTN","SROESPR1",137,0) . E W " " "RTN","SROESPR1",138,0) . W $$DATE^SROESPR(+SIGNDATE,"MM/DD/CCYY HR:MIN") "RTN","SROESPR1",139,0) . I '+$G(SRFLAG)!($E(IOST)="C") D "RTN","SROESPR1",140,0) . . I $P($$BEEP^SROESPR(+SIGNEDBY),U) W !?34,"Analog Pager: ",$P($$BEEP^SROESPR(+SIGNEDBY),U) "RTN","SROESPR1",141,0) . . I $P($$BEEP^SROESPR(+SIGNEDBY),U,2) W !?34,"Digital Pager: ",$P($$BEEP^SROESPR(+SIGNEDBY),U,2) "RTN","SROESPR1",142,0) I $G(^TMP("SRLQ",$J,SRDA,.05,"E"))="UNCOSIGNED" D "RTN","SROESPR1",143,0) . W !?34,"**REQUIRES COSIGNATURE**",! "RTN","SROESPR1",144,0) I +SIGCHRT,$P(SIGNMODE,";")="C" D SETCONT() Q:'SRCONT D "RTN","SROESPR1",145,0) . W !?2,"Marked signed on chart by:",?34,$P(SIGCHRT,";",2) "RTN","SROESPR1",146,0) I +$G(SRADD) S SRGROOT=$NA(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD)) "RTN","SROESPR1",147,0) I +$D(@SRGROOT@("EXTRASGNR")) D "RTN","SROESPR1",148,0) . N SRI S SRI=0 "RTN","SROESPR1",149,0) . D SETCONT() Q:'SRCONT W !?4,"Receipt Acknowledged By:" "RTN","SROESPR1",150,0) . F S SRI=$O(@SRGROOT@("EXTRASGNR",SRI)) Q:'SRI D "RTN","SROESPR1",151,0) . . I +$G(@SRGROOT@("EXTRASGNR",SRI,"DATE"))'>0 Q "RTN","SROESPR1",152,0) . . I SRI>1 D SETCONT() Q:'SRCONT W ! "RTN","SROESPR1",153,0) . . W ?29,"/es/ ",$G(@SRGROOT@("EXTRASGNR",SRI,"NAME")) "RTN","SROESPR1",154,0) . . W !?34,$G(@SRGROOT@("EXTRASGNR",SRI,"TITLE")) "RTN","SROESPR1",155,0) . . I $L($G(@SRGROOT@("EXTRASGNR",SRI,"TITLE")))>30 W !?34 "RTN","SROESPR1",156,0) . . E W " " "RTN","SROESPR1",157,0) . . W $$DATE^SROESPR($G(@SRGROOT@("EXTRASGNR",SRI,"DATE")),"MM/DD/CCYY HR:MIN") "RTN","SROESPR1",158,0) . . I '+$G(SRFLAG)!($E(IOST)="C") D "RTN","SROESPR1",159,0) . . . N BEEP "RTN","SROESPR1",160,0) . . . S BEEP=$$BEEP^SROESPR(+$G(@SRGROOT@("EXTRASGNR",SRI,"EXTRA"))) "RTN","SROESPR1",161,0) . . . I +BEEP W !?34,"Analog Pager: ",$P(BEEP,U) "RTN","SROESPR1",162,0) . . . I +$P(BEEP,U,2) W !?34,"Digital Pager: ",$P(BEEP,U,2) "RTN","SROESPR1",163,0) . K @SRGROOT@("EXTRASGNR") "RTN","SROESPR1",164,0) I +COSGDATE,(+COSGEDBY'=+SIGNEDBY) D SETCONT() Q:'SRCONT D "RTN","SROESPR1",165,0) . W !?16,"Cosigned by:",$S($P(COSGMODE,";")="C":" /s/ ",1:" /es/ "),?34,$S(COSGNAME]"":COSGNAME,1:$P(COSGEDBY,";",2)) "RTN","SROESPR1",166,0) . W !?34,COSGTITL," " "RTN","SROESPR1",167,0) . W $$DATE^SROESPR(+COSGDATE,"MM/DD/CCYY HR:MIN") "RTN","SROESPR1",168,0) . I '+$G(SRFLAG)!($E(IOST)="C") D "RTN","SROESPR1",169,0) . . I $P($$BEEP^SROESPR(+COSGEDBY),U) W !?34,"Analog Pager: ",$P($$BEEP^SROESPR(+COSGEDBY),U) "RTN","SROESPR1",170,0) . . I $P($$BEEP^SROESPR(+COSGEDBY),U,2) W !?34,"Digital Pager:",$P($$BEEP^SROESPR(+COSGEDBY),U,2) "RTN","SROESPR1",171,0) I +COSCHRT,$P(COSGMODE,";")="C" D SETCONT() Q:'SRCONT D "RTN","SROESPR1",172,0) . W !,"Marked cosigned on chart by:",?34,$P(COSCHRT,";",2) "RTN","SROESPR1",173,0) W ! "RTN","SROESPR1",174,0) K SRCONT1 "RTN","SROESPR1",175,0) AMEND ; signature blocks of amender "RTN","SROESPR1",176,0) S SRY=4 D SETCONT() Q:'SRCONT "RTN","SROESPR1",177,0) I +$G(@SRGROOT@(1601,"I")) D "RTN","SROESPR1",178,0) . W !!?12,"Amendment Filed:",?34,$$DATE^SROESPR(@SRGROOT@(1601,"I"),"MM/DD/CCYY HR:MIN") "RTN","SROESPR1",179,0) . I $G(@SRGROOT@(1603,"E"))']"" D "RTN","SROESPR1",180,0) . . W !!?29 F SRI=1:1:40 W "_" "RTN","SROESPR1",181,0) . . W !?29,$$SIGNAME^SROESPR(@SRGROOT@(1602,"I")) "RTN","SROESPR1",182,0) . . W !?29,$$SIGTITL^SROESPR(@SRGROOT@(1602,"I")) "RTN","SROESPR1",183,0) . I $G(@SRGROOT@(1604,"E"))]"" D "RTN","SROESPR1",184,0) . . W !?29,"/es/",?34,@SRGROOT@(1604,"E") "RTN","SROESPR1",185,0) . . W !?34,@SRGROOT@(1605,"E") "RTN","SROESPR1",186,0) Q "RTN","SROESPR1",187,0) SETCONT(SRHEAD) ;Does footer and sets SRCONT "RTN","SROESPR1",188,0) S SRCONT=$$FOOTER^SROESPR2(.SRFOOT,SRFLAG,SRPFNBR,$G(SRHEAD),$G(SRCONT1),SRDA) "RTN","SROESPR1",189,0) Q "RTN","SROGMTS") 0^2^B59971824^B49968701 "RTN","SROGMTS",1,0) SROGMTS ;BIR/ADM - SURGERY HEALTH SUMMARY ; [ 08/08/01 7:12 AM ] "RTN","SROGMTS",2,0) ;;3.0; Surgery ;**100,127,162**;24 Jun 93;Build 4 "RTN","SROGMTS",3,0) ; "RTN","SROGMTS",4,0) ;** NOTICE: This routine is part of an implementation of a nationally "RTN","SROGMTS",5,0) ;** controlled procedure. Local modifications to this routine "RTN","SROGMTS",6,0) ;** are prohibited. "RTN","SROGMTS",7,0) ; "RTN","SROGMTS",8,0) ; Reference to $$MOD^ICPTMOD supported by DBIA #1996 "RTN","SROGMTS",9,0) ; Reference to $$CPT^ICPTCOD supported by DBIA #1995 "RTN","SROGMTS",10,0) ; "RTN","SROGMTS",11,0) Q "RTN","SROGMTS",12,0) HS(X) ; return case information for a surical or non-OR case "RTN","SROGMTS",13,0) ; X - case number (IEN) in file 130 "RTN","SROGMTS",14,0) K REC N SRCPTM,SRSG,DA,DR,DIC,DIQ,IEN,IENS,FILE,FLD,FLDS,FLDI "RTN","SROGMTS",15,0) N FLDA,FLDB,FLDR,FLDRT,IEN,SRI,SRRT,SRT,SRS,SRC,SRCS "RTN","SROGMTS",16,0) S SRCPTM=1 "RTN","SROGMTS",17,0) Q:'$D(^SRF(X,0)) S (IENS,IEN,X)=+($G(X)),U="^" "RTN","SROGMTS",18,0) S:'$D(DT) DT=$$HTFM^XLFDT($H,1) S:'$D(DTIME) DTIME=300 "RTN","SROGMTS",19,0) S (FILE,DIC)=130,DA=+($G(X)),DIQ="REC(",DIQ(0)="IE" "RTN","SROGMTS",20,0) S SRSG=$$SG(IEN),REC(130,IEN,118,"E")=$S(SRSG=0:"YES",1:""),REC(130,IEN,118,"I")=$S(SRSG=0:"Y",1:"") "RTN","SROGMTS",21,0) S:+SRSG DR=".09;.04;.14;.164;.205;.22;.23;.31;10;15;17;26;27;32;34;36;39;43;49;50" "RTN","SROGMTS",22,0) S:'SRSG DR=".09;.31;26;27;33;50;55;59;66;121;122;123;124;125" "RTN","SROGMTS",23,0) D EN^DIQ1 S REC(130,IEN,"STATUS")=$$OS(IEN) S:+SRSG REC(130,IEN,"VERIFIED")=$S($G(REC(130,IEN,43,"I"))'="Y":"(Unverified)",1:"") "RTN","SROGMTS",24,0) S SRM=$G(REC(130,IEN,27,"I")) I SRM>0 D CPT(SRM,$P($G(^SRF(IEN,0)),"^",9),130,27) "RTN","SROGMTS",25,0) D DICT^SROGMTS0,SUB,SPD "RTN","SROGMTS",26,0) S:$D(REC(130,IEN,32)) REC(130,IEN,32,"S")=$$EN2^SROGMTS0($G(REC(130,IEN,32,"E"))) "RTN","SROGMTS",27,0) S:$D(REC(130,IEN,33)) REC(130,IEN,33,"S")=$$EN2^SROGMTS0($G(REC(130,IEN,33,"E"))) "RTN","SROGMTS",28,0) S:$D(REC(130,IEN,34)) REC(130,IEN,34,"S")=$$EN2^SROGMTS0($G(REC(130,IEN,34,"E"))) "RTN","SROGMTS",29,0) S:$D(REC(130,IEN,.04)) REC(130,IEN,.04,"S")=$$EN2^SROGMTS0($G(REC(130,IEN,.04,"E"))) "RTN","SROGMTS",30,0) S:$D(REC(130,IEN,125)) REC(130,IEN,125,"S")=$$EN2^SROGMTS0($G(REC(130,IEN,125,"E"))) "RTN","SROGMTS",31,0) I $L($G(REC(130,IEN,33,"S"))) D "RTN","SROGMTS",32,0) . S:'$L($G(REC(130,IEN,66,"E"))) REC(130,IEN,33,"S")=$G(REC(130,IEN,33,"S"))_" (Unknown)" "RTN","SROGMTS",33,0) . S:$L($G(REC(130,IEN,66,"E"))) REC(130,IEN,33,"S")=$G(REC(130,IEN,33,"S"))_" (ICD "_$G(REC(130,IEN,66,"E"))_")" "RTN","SROGMTS",34,0) S:+($G(REC(130,IEN,.09,"I")))>0 REC(130,IEN,.09,"S")=$$ED^SROGMTS0($G(REC(130,IEN,.09,"I"))) "RTN","SROGMTS",35,0) S:+($G(REC(130,IEN,15,"I")))>0 REC(130,IEN,15,"S")=$$EDT^SROGMTS0($G(REC(130,IEN,15,"I"))) "RTN","SROGMTS",36,0) S:+($G(REC(130,IEN,39,"I"))) REC(130,IEN,39,"S")=$$EDT^SROGMTS0($G(REC(130,IEN,39,"I"))) "RTN","SROGMTS",37,0) S:+SRSG REC(130,IEN,"LAB")=$S($O(REC(130,IEN,49,0))>0:"Yes",1:"") "RTN","SROGMTS",38,0) I 'SRSG D:+($O(REC(130,IEN,55,0)))>0 WP(IEN,55,58) D:+($O(REC(130,IEN,59,0)))>0 WP(IEN,59,58) "RTN","SROGMTS",39,0) Q "RTN","SROGMTS",40,0) ED(X) ; external date "RTN","SROGMTS",41,0) S X=$G(X) Q:'$L(X) "" "RTN","SROGMTS",42,0) S X=$TR($$FMTE^XLFDT(X,"5DZ"),"@"," ") "RTN","SROGMTS",43,0) Q X "RTN","SROGMTS",44,0) EDT(X) ; external date and time "RTN","SROGMTS",45,0) S X=$G(X) Q:'$L(X) "" "RTN","SROGMTS",46,0) S X=$TR($$FMTE^XLFDT(X,"2ZM"),"@"," ") "RTN","SROGMTS",47,0) Q X "RTN","SROGMTS",48,0) WP(X,Y,Z) ; "RTN","SROGMTS",49,0) N SRI,SRF,SRW,SRGI,DIWF,DIWL,DIWR "RTN","SROGMTS",50,0) S SRI=+($G(X)) Q:SRI=0!('$D(REC(130,SRI))) "RTN","SROGMTS",51,0) S SRF=+($G(Y)) Q:SRF=0!('$D(REC(130,SRI,SRF))) "RTN","SROGMTS",52,0) S SRW=+($G(Z)) Q:SRW'>0!(SRW>79) "RTN","SROGMTS",53,0) Q:+($O(REC(130,SRI,SRF,0)))'>0 "RTN","SROGMTS",54,0) K ^UTILITY($J,"W") S DIWF="C"_SRW,DIWL=0,DIWR=0,SRGI=0 "RTN","SROGMTS",55,0) F S SRGI=$O(REC(130,SRI,SRF,SRGI)) Q:+SRGI=0 D "RTN","SROGMTS",56,0) . S X=$G(REC(130,SRI,SRF,SRGI)) "RTN","SROGMTS",57,0) . D ^DIWP "RTN","SROGMTS",58,0) S SRGI=0 F S SRGI=$O(^UTILITY($J,"W",0,SRGI)) Q:+SRGI=0 D "RTN","SROGMTS",59,0) . S REC(130,SRI,SRF,"S",SRGI)=$G(^UTILITY($J,"W",0,SRGI,0)) "RTN","SROGMTS",60,0) . S REC(130,SRI,SRF,"S",0)=$G(REC(130,SRI,SRF,"S",0))+1 "RTN","SROGMTS",61,0) K ^UTILITY($J,"W") "RTN","SROGMTS",62,0) Q "RTN","SROGMTS",63,0) OS(X) ; Obtains status for OR procedures "RTN","SROGMTS",64,0) N SRN S SRN=+($G(X)) S X="" I $G(REC(130,SRN,118,"I"))="Y" D Q X "RTN","SROGMTS",65,0) . S:+($G(REC(130,SRN,122,"I")))>0 X="(Completed)" "RTN","SROGMTS",66,0) . S:+($G(REC(130,SRN,121,"I")))>0&(+($G(REC(130,SRN,122,"I")))'>0) X="Incomplete" "RTN","SROGMTS",67,0) . S:X="" X="Unknown" "RTN","SROGMTS",68,0) I +($G(REC(130,SRN,17,"I")))>0 D Q X "RTN","SROGMTS",69,0) . S X=$S(+($G(REC(130,SRN,.205,"I")))>0:"(Aborted)",1:"Cancelled") "RTN","SROGMTS",70,0) I +($G(REC(130,SRN,.23,"I")))>0 S X="(Completed)" Q X "RTN","SROGMTS",71,0) I +($G(REC(130,SRN,.22,"I")))>0 S X="Incomplete" Q X "RTN","SROGMTS",72,0) I +($G(REC(130,SRN,10,"I")))>0 S X="Scheduled" Q X "RTN","SROGMTS",73,0) I +($G(REC(130,SRN,36,"I")))>0,+($G(REC(130,SRN,.22,"I")))'>0 S X="Requested" Q X "RTN","SROGMTS",74,0) S X="Unknown" "RTN","SROGMTS",75,0) Q X "RTN","SROGMTS",76,0) SUB ; "RTN","SROGMTS",77,0) N DA,DR,DIC,DIQ,IENS,FILE,FLD,FLDS,FLDI,FLDA,FLDB,FLDR,FLDRT,SRM,SRC,SRI,SRJ,STXT,SNAM,SCOD,SUB "RTN","SROGMTS",78,0) I +SRSG D "RTN","SROGMTS",79,0) . ; "RTN","SROGMTS",80,0) . ; ^SRF(DO,14,I) .72 Other Preop Diag 14;0 130.17 "RTN","SROGMTS",81,0) . ; $P(^SRF(DO,14,I,0),U) .01 Other Preop Diag 0;1 Text "RTN","SROGMTS",82,0) . ; "RTN","SROGMTS",83,0) . S DA=IEN,(FILE,DIC)=130,SUB=130.17,DR=.72,DR(SUB)=".01",DIQ="REC(130,"_IEN_",",DIQ(0)="IE" "RTN","SROGMTS",84,0) . K REC(SUB) S SRI=0 F S SRI=$O(^SRF(+($G(IEN)),14,SRI)) Q:+SRI=0 D "RTN","SROGMTS",85,0) . . S DA(SUB)=SRI "RTN","SROGMTS",86,0) . . D EN^DIQ1 "RTN","SROGMTS",87,0) . . S REC(130,IEN,130.17,SRI,.01,"S")=$$EN2^SROGMTS0($G(REC(130,IEN,130.17,SRI,.01,"E"))) "RTN","SROGMTS",88,0) . ; "RTN","SROGMTS",89,0) . ; ^SRF(DO,15,I) .74 Other Postop Diags 15;0 130.18 "RTN","SROGMTS",90,0) . ; $P(^SRF(DO,15,I,0),U) .01 Other Postop Diags 0;1 Text "RTN","SROGMTS",91,0) . ; "RTN","SROGMTS",92,0) . S DA=IEN,(FILE,DIC)=130,SUB=130.18,DR=.74,DR(SUB)=".01",DIQ="REC(130,"_IEN_",",DIQ(0)="IE" "RTN","SROGMTS",93,0) . K REC(SUB) S SRI=0 F S SRI=$O(^SRF(+($G(IEN)),15,SRI)) Q:+SRI=0 D "RTN","SROGMTS",94,0) . . S DA(SUB)=SRI "RTN","SROGMTS",95,0) . . D EN^DIQ1 "RTN","SROGMTS",96,0) . . S REC(130,IEN,130.18,SRI,.01,"S")=$$EN2^SROGMTS0($G(REC(130,IEN,130.18,SRI,.01,"E"))) "RTN","SROGMTS",97,0) ; "RTN","SROGMTS",98,0) ; ^SRF(SRN,"OPMOD",I) 28 Pri Pro CPT Mod OPMOD;0 130.028 "RTN","SROGMTS",99,0) ; $P(^SRF(SRN,"OPMOD",I,0),U) .01 Pri Pro CPT Mod 0;1 Ptr 81.3 "RTN","SROGMTS",100,0) ; "RTN","SROGMTS",101,0) I SRCPTM D "RTN","SROGMTS",102,0) . S DA=IEN,(FILE,DIC)=130,SUB=130.028,DR=28,DR(SUB)=".01",DIQ="REC(130,"_IEN_",",DIQ(0)="IE" "RTN","SROGMTS",103,0) . K REC(SUB) S SRI=0 F S SRI=$O(^SRF(+($G(IEN)),"OPMOD",SRI)) Q:+SRI=0 D "RTN","SROGMTS",104,0) . . S DA(SUB)=SRI "RTN","SROGMTS",105,0) . . D EN^DIQ1 "RTN","SROGMTS",106,0) . . S SRM=+($G(REC(130,+($G(IEN)),SUB,+($G(SRI)),.01,"I"))) I SRM>0 D MOD(SRM,FILE,SUB) "RTN","SROGMTS",107,0) ; "RTN","SROGMTS",108,0) ; ^SRF(DO,13,I) .42 Other Proc 13;0 130.16 "RTN","SROGMTS",109,0) ; $P(^SRF(DO,13,I,0),U) .01 Other Proc 0;1 Text "RTN","SROGMTS",110,0) ; $P(^SRF(DO,13,I,2),U) 3 Other Proc CPT Code 2;1 Ptr 81 "RTN","SROGMTS",111,0) ; "RTN","SROGMTS",112,0) S DA=IEN,(FILE,DIC)=130,SUB=130.16,DR=.42,DR(SUB)=".01;3",DIQ="REC(130,"_IEN_",",DIQ(0)="IE" "RTN","SROGMTS",113,0) K REC(SUB) S SRI=0 F S SRI=$O(^SRF(+($G(IEN)),13,SRI)) Q:+SRI=0 D "RTN","SROGMTS",114,0) . S DA(SUB)=SRI "RTN","SROGMTS",115,0) . D EN^DIQ1 S SRM=+($G(REC(130,IEN,130.16,SRI,3,"I"))) "RTN","SROGMTS",116,0) . S:SRM>0 REC(130,IEN,130.16,SRI,3,"N")=$P($$CPT^ICPTCOD(+SRM,$P($G(^SRF(IEN,0)),"^",9)),"^",3) "RTN","SROGMTS",117,0) . N SRT,SRS,SRC S SRM=$G(REC(130,IEN,130.16,SRI,3,"I")) I SRM>0 D "RTN","SROGMTS",118,0) . . S SRC=$$CPT^ICPTCOD(SRM,$P($G(^SRF(IEN,0)),"^",9)),(SRCS,SRS)=$$EN2^SROGMTS0($P(SRC,"^",3)) "RTN","SROGMTS",119,0) . . S REC(130,IEN,130.16,SRI,3,"X")=$P(SRC,"^",2)_"^"_$P(SRC,"^",3) "RTN","SROGMTS",120,0) . . S SRC=$P(SRC,"^",2) "RTN","SROGMTS",121,0) . . S SRT=$$EN2^SROGMTS0($G(REC(130,IEN,130.16,SRI,.01,"E"))) "RTN","SROGMTS",122,0) . . S:$L(SRS)&(SRS'=SRT) SRT=SRT_" - "_$$EN2^SROGMTS0(SRS) "RTN","SROGMTS",123,0) . . S:$L(SRC)=5 SRT=SRT_" (CPT "_SRC_")",SRCS=SRCS_" (CPT "_SRC_")" "RTN","SROGMTS",124,0) . . S REC(130,IEN,130.16,SRI,3,"N")=SRS "RTN","SROGMTS",125,0) . . S REC(130,IEN,130.16,SRI,.01,"S")=SRT "RTN","SROGMTS",126,0) . . S REC(130,IEN,130.16,SRI,3,"S")=SRCS "RTN","SROGMTS",127,0) . ; "RTN","SROGMTS",128,0) . ; ^SRF(8,13,2,"MOD",0) 4 Oth Proc CPT Mod MOD;0 130.164 "RTN","SROGMTS",129,0) . ; ^SRF(8,13,2,"MOD",1,0) .01 Oth Proc CPT Mod 0;1 Ptr 81.3 "RTN","SROGMTS",130,0) . ; "RTN","SROGMTS",131,0) . I SRCPTM D "RTN","SROGMTS",132,0) . . N SRJ S SRJ=0 F S SRJ=$O(^SRF(+($G(IEN)),13,SRI,"MOD",SRJ)) Q:+SRJ=0 D "RTN","SROGMTS",133,0) . . . N DA,FILE,DIC,SUB,DR,DIQ S DA=IEN,DR=.42,FILE=130,SUB=130.16,DR(SUB)="4",DA(SUB)=SRI,SUB=130.164,DR(SUB)=".01",DA(SUB)=SRJ,DIC=130,DIQ="REC(130,"_IEN_",130.16,"_SRI_",",DIQ(0)="IE" "RTN","SROGMTS",134,0) . . . D EN^DIQ1 "RTN","SROGMTS",135,0) . . . S SRM=+($G(REC(130,IEN,130.16,SRI,130.164,SRJ,.01,"I"))) "RTN","SROGMTS",136,0) . . . I SRM>0 N SRMOD1 D "RTN","SROGMTS",137,0) . . . . S SRMOD1=$$MOD^ICPTMOD(+SRM,"I",$P($G(^SRF(IEN,0)),"^",9)) "RTN","SROGMTS",138,0) . . . . S SRC=$P(SRMOD1,"^",2) "RTN","SROGMTS",139,0) . . . . S SRS=$P(SRMOD1,"^",3) "RTN","SROGMTS",140,0) . . . . S REC(130,IEN,130.16,SRI,SUB,SRJ,.01,"MID")=SRC "RTN","SROGMTS",141,0) . . . . S REC(130,IEN,130.16,SRI,SUB,SRJ,.01,"MOD")=SRS "RTN","SROGMTS",142,0) . . . . S REC(130,IEN,130.16,SRI,SUB,SRJ,.01,"X")=SRC_"^"_SRS "RTN","SROGMTS",143,0) . . . . S SRT=$$EN2^SROGMTS0(SRS) S:$L(SRC) SRT=SRT_" (CPT Mod "_SRC_")" "RTN","SROGMTS",144,0) . . . . S REC(130,IEN,130.16,SRI,SUB,SRJ,.01,"S")=SRT "RTN","SROGMTS",145,0) . . . K REC(130,IEN,130.16,SRI,130) "RTN","SROGMTS",146,0) Q "RTN","SROGMTS",147,0) SG(X) ; Surgical (Operative) Record "RTN","SROGMTS",148,0) S X=$$GET1^DIQ(130,+($G(X)),118,"I") S X=$S(X["Y":0,1:1) Q X "RTN","SROGMTS",149,0) CPT(SRM,SRDOO,SRFIL,SRFLD) ;Set CPT code into REC array "RTN","SROGMTS",150,0) S SRC=$$CPT^ICPTCOD(SRM,SRDOO),(SRCS,SRS)=$$EN2^SROGMTS0($P(SRC,"^",3)) "RTN","SROGMTS",151,0) S REC(SRFIL,IEN,SRFLD,"X")=$P(SRC,"^",2)_"^"_$P(SRC,"^",3) "RTN","SROGMTS",152,0) S SRC=$P(SRC,"^",2),SRT=$$EN2^SROGMTS0($G(REC(130,IEN,26,"E"))) "RTN","SROGMTS",153,0) S:$L(SRS)&(SRS'=SRT) SRT=SRT_" - "_SRS "RTN","SROGMTS",154,0) S:$L(SRC)=5 SRT=SRT_" (CPT "_SRC_")",SRCS=SRCS_" (CPT "_SRC_")" "RTN","SROGMTS",155,0) S REC(SRFIL,IEN,SRFLD,"N")=SRS "RTN","SROGMTS",156,0) S:SRFIL=130 REC(130,IEN,26,"S")=SRT "RTN","SROGMTS",157,0) S REC(SRFIL,IEN,SRFLD,"S")=SRT "RTN","SROGMTS",158,0) S REC(SRFIL,IEN,SRFLD,"S")=SRCS "RTN","SROGMTS",159,0) Q "RTN","SROGMTS",160,0) MOD(SRM,SRFIL,SUB) ;Set CPT Modifier into REC array "RTN","SROGMTS",161,0) S SRMOD=$$MOD^ICPTMOD(+SRM,"I",$P($G(^SRF(IEN,0)),"^",9)) "RTN","SROGMTS",162,0) S SRC=$P(SRMOD,"^",2) "RTN","SROGMTS",163,0) S SRS=$P(SRMOD,"^",3) "RTN","SROGMTS",164,0) S REC(SRFIL,IEN,SUB,SRI,.01,"MID")=SRC "RTN","SROGMTS",165,0) S REC(SRFIL,IEN,SUB,SRI,.01,"MOD")=SRS "RTN","SROGMTS",166,0) S SRT=$$EN2^SROGMTS0(SRS) "RTN","SROGMTS",167,0) S:$L(SRC) SRT=SRT_" (CPT Mod "_SRC_")" "RTN","SROGMTS",168,0) S REC(SRFIL,IEN,SUB,SRI,.01,"S")=SRT "RTN","SROGMTS",169,0) Q "RTN","SROGMTS",170,0) SPD ;Obtain Surgery Procedure/Diagnosis Code File entry "RTN","SROGMTS",171,0) S (FILE,DIC)=136,DA=+($G(IEN)),DIQ="REC(",DIQ(0)="IE" "RTN","SROGMTS",172,0) S DR=".01;.02;.03;10" "RTN","SROGMTS",173,0) D EN^DIQ1 "RTN","SROGMTS",174,0) Q:'+$G(REC(FILE,IEN,10,"I")) "RTN","SROGMTS",175,0) S SRM=+$G(REC(FILE,IEN,.02,"I")) "RTN","SROGMTS",176,0) Q:'(SRM>0) D CPT(SRM,$P($G(^SRF(IEN,0)),"^",9),FILE,.02) "RTN","SROGMTS",177,0) S SUB=136.01,DR=1,DR(SUB)=".01",DIQ="REC(136,"_IEN_"," "RTN","SROGMTS",178,0) K REC(FILE,IEN,SUB) S SRI=0 F S SRI=$O(^SRO(FILE,(+$G(IEN)),DR,SRI)) Q:+SRI=0 D "RTN","SROGMTS",179,0) .S DA(SUB)=SRI "RTN","SROGMTS",180,0) .D EN^DIQ1 "RTN","SROGMTS",181,0) .S SRM=REC(FILE,IEN,SUB,SRI,.01,"I") I SRM>0 D MOD(SRM,FILE,SUB) "RTN","SROGMTS",182,0) N DA S DA=IEN,SUB=136.011,DR=11,DR(SUB)=".01;1" "RTN","SROGMTS",183,0) K REC(FILE,IEN,SUB) S SRI=0 F S SRI=$O(^SRO(FILE,(+$G(IEN)),DR,SRI)) Q:+SRI=0 D "RTN","SROGMTS",184,0) . S DA(SUB)=SRI "RTN","SROGMTS",185,0) . D EN^DIQ1 "RTN","SROGMTS",186,0) S $P(REC(130,IEN,26,"S"),"-",2)=" "_REC(FILE,IEN,.02,"S") "RTN","SROGMTS",187,0) K REC(130,IEN,130.028) M REC(130,IEN,130.028)=REC(FILE,IEN,136.01) "RTN","SROGMTS",188,0) Q "RTN","SROWL") 0^3^B27493770^B27135451 "RTN","SROWL",1,0) SROWL ;B'HAM ISC/MAM - ENTER PATIENT ON WAITING LIST ; 4/18/07 11:55am "RTN","SROWL",2,0) ;;3.0;Surgery;**58,119,162**;24 Jun 93;Build 4 "RTN","SROWL",3,0) ; "RTN","SROWL",4,0) ENTER ; enter a patient on the waiting list "RTN","SROWL",5,0) S SRSOUT=0 W @IOF K DIC S DIC(0)="QEAMZL",(DIC,DLAYGO)=133.8,DIC("A")=" Select Surgical Specialty: " D ^DIC K DIC,DLAYGO G:Y<0 END S SRSS=+Y,SRSS1=+Y(0) "RTN","SROWL",6,0) S SRSSNM=$P(^SRO(137.45,SRSS1,0),"^") "RTN","SROWL",7,0) PAT W ! S DIC=2,DIC(0)="QEAMZ",DIC("A")=" Select Patient: " D ^DIC K DIC I Y<0 W !!,"No action taken." G END "RTN","SROWL",8,0) S DFN=+Y,SRNM=$P(Y(0),"^") I $D(^DPT(DFN,.35)),$P(^(.35),"^")'="" S Y=$E($P(^(.35),"^"),1,7) D D^DIQ W !!,"The records show that "_SRNM_" died on "_Y_".",! G PAT "RTN","SROWL",9,0) I $O(^SRO(133.8,"AP",DFN,SRSS,0)) D CHK G:"Yy"'[ECYN END "RTN","SROWL",10,0) OP W ! K DIR S DIR("A")=" Select Operative Procedure",DIR(0)="133.801,1" D ^DIR I $D(DTOUT)!$D(DUOUT) W !!,"No action taken." G END "RTN","SROWL",11,0) S SROPER=Y "RTN","SROWL",12,0) W ! D NOW^%DTC S SRSDT=% "RTN","SROWL",13,0) K DD,DO,DIC,DR,DA S DIC(0)="L",DIC="^SRO(133.8,SRSS,1,",DA(1)=SRSS,X=DFN D FILE^DICN I +Y S SROFN=+Y "RTN","SROWL",14,0) K DA,DIE,DR S DA=SRSS,DIE=133.8,DR="1///"_SRNM,DR(2,133.801)="1////"_SROPER_";2///"_SRSDT_";4T;W !;5T;6T;W !;3T",DR(3,133.8013)=".01T;1T;2T;3T;4T;5T" D ^DIE K DIE,DR "RTN","SROWL",15,0) D WL^SROPCE1 I SRSOUT G DEL "RTN","SROWL",16,0) W @IOF,!,SRNM_" has been entered on the waiting list",!,"for "_SRSSNM "RTN","SROWL",17,0) END D PRESS,^SRSKILL W @IOF "RTN","SROWL",18,0) Q "RTN","SROWL",19,0) PRESS W ! K DIR S DIR("A")="Press RETURN to continue ",DIR(0)="FOA" D ^DIR K DIR "RTN","SROWL",20,0) Q "RTN","SROWL",21,0) DEL S DA(1)=SRSS,DA=SROFN,DIK="^SRO(133.8,"_DA(1)_",1," D ^DIK "RTN","SROWL",22,0) W @IOF,!,"Classification information is incomplete. No action taken." G END "RTN","SROWL",23,0) Q "RTN","SROWL",24,0) HELP W !!,"Enter RETURN if you want to continue entering a new procedure on the waiting",!,"list for "_SRNM_". If the procedure you are about to enter appears",!,"above, enter 'NO' to quit this option." "RTN","SROWL",25,0) W !!,"Press RETURN to continue " R X:DTIME "RTN","SROWL",26,0) Q "RTN","SROWL",27,0) CHK ; check for existing entries for a patient "RTN","SROWL",28,0) W @IOF,!,"Procedure(s) already entered for "_SRNM,!,"on the Waiting List for "_SRSSNM,! "RTN","SROWL",29,0) S SROFN=0 F S SROFN=$O(^SRO(133.8,"AP",DFN,SRSS,SROFN)) Q:'SROFN D LIST "RTN","SROWL",30,0) W !!,"Do you wish to continue entering a new procedure for "_SRNM_" on",!,"the waiting list for "_SRSSNM_" ? YES// " R ECYN:DTIME I '$T!(ECYN["^") S ECYN="N" Q "RTN","SROWL",31,0) S ECYN=$E(ECYN) S:"y"[ECYN ECYN="Y" "RTN","SROWL",32,0) I "YNn"'[ECYN D HELP G CHK "RTN","SROWL",33,0) Q "RTN","SROWL",34,0) LIST ; list existing procedures for specialty selected "RTN","SROWL",35,0) S SROPER=$P(^SRO(133.8,SRSS,1,SROFN,0),"^",2),SRDT=$P(^(0),"^",3),SROPDT=$P(^(0),"^",5),Y=SRDT D D^DIQ S SRDT=$E(Y,1,12) I SROPDT S Y=SROPDT D D^DIQ S SROPDT=$E(Y,1,12) "RTN","SROWL",36,0) K SROP,MM,MMM S:$L(SROPER)<36 SROP(1)=SROPER I $L(SROPER)>35 S SROPER=SROPER_" " S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM="" "RTN","SROWL",37,0) W !,SRNM,?40,"Date Entered on List:",?66,SRDT,!,?3,SROP(1),?40,"Tentative Operation Date: ",?66,SROPDT "RTN","SROWL",38,0) I $D(SROP(2)) W !,?3,SROP(2) "RTN","SROWL",39,0) W ! "RTN","SROWL",40,0) Q "RTN","SROWL",41,0) LOOP ; break procedure if greater than 36 characters "RTN","SROWL",42,0) S SROP(M)="" F LOOP=1:1 S MM=$P(SROPER," "),MMM=$P(SROPER," ",2,200) Q:MMM="" Q:$L(SROP(M))+$L(MM)'<36 S SROP(M)=SROP(M)_MM_" ",SROPER=MMM "RTN","SROWL",43,0) Q "RTN","SROWL",44,0) REFPHY ; Look up Referring Physician in "New Person" file with filter and auto-populate Referring Physician demographic fields "RTN","SROWL",45,0) N SRCONT,Y,SRDEMO "RTN","SROWL",46,0) S SRCONT="" "RTN","SROWL",47,0) PRMPT R !,"Is this a VA Physician from this facility? (Y/N): ",SRCONT:DTIME I '$T Q "RTN","SROWL",48,0) I SRCONT["?" D G PRMPT "RTN","SROWL",49,0) .W !!,"Enter 'Y' if you would like to select the Referring Physician from this facility's VA personnel.",!,"Enter 'N' to continue data entry.",! "RTN","SROWL",50,0) S:SRCONT="" SRCONT="Y" "RTN","SROWL",51,0) I SRCONT="^" S X="" Q "RTN","SROWL",52,0) Q:(SRCONT'["Y")&(SRCONT'["y") "RTN","SROWL",53,0) ; Store FileMan variables and arrays "RTN","SROWL",54,0) M SRDABAK=DA,SRDICBAK=DIC,SRDZERO=D0,SRDRBAK=DR,SRXBAK=X,SRDOBAK=DO "RTN","SROWL",55,0) ; Setup variables and call ^DIC to lookup REFERRING PHYSICIAN from NEW PERSON file "RTN","SROWL",56,0) S DIC="^VA(200,",DIC(0)="E",DIC("B")=X "RTN","SROWL",57,0) D ^DIC "RTN","SROWL",58,0) ; Restore FileMan's variables and arrays "RTN","SROWL",59,0) M DA=SRDABAK,DIC=SRDICBAK,D0=SRDZERO,DR=SRDRBAK,X=SRXBAK,DO=SRDOBAK "RTN","SROWL",60,0) K SRCONT,SRDABAK,SRDICBAK,SRDZERO,SRDRBAK,SRXBAK,SRDOBAK "RTN","SROWL",61,0) Q:Y="-1" ; Quit if no record was selected from the NEW PERSON file "RTN","SROWL",62,0) S SRNPREC=$P(Y,U,1)_"," ;The record number of the NEW PERSON file "RTN","SROWL",63,0) ; Retrieve demographic data from the NEW PERSON file. "RTN","SROWL",64,0) D GETS^DIQ(200,SRNPREC,".01:.116;.132","","SRDEMO") "RTN","SROWL",65,0) ; Build SRDEMO array for "stuffing" into REFERRING PHYSICIAN demographic fields "RTN","SROWL",66,0) S X=SRDEMO(200,SRNPREC,".01") ;Name "RTN","SROWL",67,0) S SRDEMO(1)=SRDEMO(200,SRNPREC,".111") ;Address "RTN","SROWL",68,0) S:$L(SRDEMO(200,SRNPREC,".112"))>0 SRDEMO(1)=SRDEMO(1)_" "_SRDEMO(200,SRNPREC,".112") ;Concatenate Address 2 to single address "RTN","SROWL",69,0) S:$L(SRDEMO(200,SRNPREC,".113"))>0 SRDEMO(1)=SRDEMO(1)_" "_SRDEMO(200,SRNPREC,".113") ;Concatenate Address 3 to single address "RTN","SROWL",70,0) S SRDEMO(1)=$E(SRDEMO(1),1,75) "RTN","SROWL",71,0) S SRDEMO(2)=SRDEMO(200,SRNPREC,".114") ;City "RTN","SROWL",72,0) S SRDEMO(3)=SRDEMO(200,SRNPREC,".115") ;State "RTN","SROWL",73,0) S SRDEMO(4)=SRDEMO(200,SRNPREC,".116") ;Zip "RTN","SROWL",74,0) S SRDEMO(5)=SRDEMO(200,SRNPREC,".132") ;Office Phone "RTN","SROWL",75,0) ; Set up DR array that FileMan will use, with a call to ^DIE, after this subroutine Quits to "stuff" the demographic data. "RTN","SROWL",76,0) ; all fields except STATE will ignore input transform (SR*3.0*162) "RTN","SROWL",77,0) S DIC("DR")="1////"_SRDEMO(1)_";2////"_SRDEMO(2)_";3///"_SRDEMO(3)_";4////"_SRDEMO(4)_";5////"_SRDEMO(5)_";6////"_$P(Y,U,1) "RTN","SROWL",78,0) S DIC(0)="Z" ;Tells FileMan to file the data without any more user input "RTN","SROWL",79,0) Q "VER") 8.0^22.0 "BLD",6590,6) ^159 **END** **END**