EMERGENCY Released DG*5.3*757 SEQ #674 Extracted from mail message **KIDS**:DG*5.3*757^ **INSTALL NAME** DG*5.3*757 "BLD",6669,0) DG*5.3*757^REGISTRATION^0^3070730^y "BLD",6669,4,0) ^9.64PA^45.3^2 "BLD",6669,4,45,0) 45 "BLD",6669,4,45,2,0) ^9.641^45.01^1 "BLD",6669,4,45,2,45.01,0) 401 (sub-file) "BLD",6669,4,45,2,45.01,1,0) ^9.6411^3^1 "BLD",6669,4,45,2,45.01,1,3,0) SURGICAL SPECIALTY "BLD",6669,4,45,222) y^n^p^^^^n^^n "BLD",6669,4,45,224) "BLD",6669,4,45.3,0) 45.3 "BLD",6669,4,45.3,2,0) ^9.641^45.3^1 "BLD",6669,4,45.3,2,45.3,0) SURGICAL SPECIALTY (File-top level) "BLD",6669,4,45.3,2,45.3,1,0) ^9.6411^.01^1 "BLD",6669,4,45.3,2,45.3,1,.01,0) CODE "BLD",6669,4,45.3,222) y^n^p^^^^n^^n "BLD",6669,4,45.3,224) "BLD",6669,4,"APDD",45,45.01) "BLD",6669,4,"APDD",45,45.01,3) "BLD",6669,4,"APDD",45.3,45.3) "BLD",6669,4,"APDD",45.3,45.3,.01) "BLD",6669,4,"B",45,45) "BLD",6669,4,"B",45.3,45.3) "BLD",6669,6.3) 5 "BLD",6669,"ABPKG") n "BLD",6669,"INI") PRE^DG53757P "BLD",6669,"INIT") POST^DG53757P "BLD",6669,"KRN",0) ^9.67PA^8989.52^19 "BLD",6669,"KRN",.4,0) .4 "BLD",6669,"KRN",.401,0) .401 "BLD",6669,"KRN",.402,0) .402 "BLD",6669,"KRN",.402,"NM",0) ^9.68A^1^1 "BLD",6669,"KRN",.402,"NM",1,0) DG401 FILE #45^45^0 "BLD",6669,"KRN",.402,"NM","B","DG401 FILE #45",1) "BLD",6669,"KRN",.403,0) .403 "BLD",6669,"KRN",.5,0) .5 "BLD",6669,"KRN",.84,0) .84 "BLD",6669,"KRN",3.6,0) 3.6 "BLD",6669,"KRN",3.8,0) 3.8 "BLD",6669,"KRN",9.2,0) 9.2 "BLD",6669,"KRN",9.8,0) 9.8 "BLD",6669,"KRN",9.8,"NM",0) ^9.68A^1^1 "BLD",6669,"KRN",9.8,"NM",1,0) DG53757P^^0^B11371575 "BLD",6669,"KRN",9.8,"NM","B","DG53757P",1) "BLD",6669,"KRN",19,0) 19 "BLD",6669,"KRN",19.1,0) 19.1 "BLD",6669,"KRN",101,0) 101 "BLD",6669,"KRN",409.61,0) 409.61 "BLD",6669,"KRN",771,0) 771 "BLD",6669,"KRN",870,0) 870 "BLD",6669,"KRN",8989.51,0) 8989.51 "BLD",6669,"KRN",8989.52,0) 8989.52 "BLD",6669,"KRN",8994,0) 8994 "BLD",6669,"KRN","B",.4,.4) "BLD",6669,"KRN","B",.401,.401) "BLD",6669,"KRN","B",.402,.402) "BLD",6669,"KRN","B",.403,.403) "BLD",6669,"KRN","B",.5,.5) "BLD",6669,"KRN","B",.84,.84) "BLD",6669,"KRN","B",3.6,3.6) "BLD",6669,"KRN","B",3.8,3.8) "BLD",6669,"KRN","B",9.2,9.2) "BLD",6669,"KRN","B",9.8,9.8) "BLD",6669,"KRN","B",19,19) "BLD",6669,"KRN","B",19.1,19.1) "BLD",6669,"KRN","B",101,101) "BLD",6669,"KRN","B",409.61,409.61) "BLD",6669,"KRN","B",771,771) "BLD",6669,"KRN","B",870,870) "BLD",6669,"KRN","B",8989.51,8989.51) "BLD",6669,"KRN","B",8989.52,8989.52) "BLD",6669,"KRN","B",8994,8994) "BLD",6669,"PRE") DG53757P "BLD",6669,"QUES",0) ^9.62^^ "BLD",6669,"REQB",0) ^9.611^1^1 "BLD",6669,"REQB",1,0) DG*5.3*729^2 "BLD",6669,"REQB","B","DG*5.3*729",1) "FIA",45) PTF "FIA",45,0) ^DGPT( "FIA",45,0,0) 45IP "FIA",45,0,1) y^n^p^^^^n^^n "FIA",45,0,10) "FIA",45,0,11) "FIA",45,0,"RLRO") "FIA",45,0,"VR") 5.3^DG "FIA",45,45) 1 "FIA",45,45.01) 1 "FIA",45,45.01,3) "FIA",45.3) SURGICAL SPECIALTY "FIA",45.3,0) ^DIC(45.3, "FIA",45.3,0,0) 45.3I "FIA",45.3,0,1) y^n^p^^^^n^^n "FIA",45.3,0,10) "FIA",45.3,0,11) "FIA",45.3,0,"RLRO") "FIA",45.3,0,"VR") 5.3^DG "FIA",45.3,45.3) 1 "FIA",45.3,45.3,.01) "INI") PRE^DG53757P "INIT") POST^DG53757P "KRN",.402,218,-1) 0^1 "KRN",.402,218,0) DG401^3061024.1041^^45^^^3070726 "KRN",.402,218,"AR",45.01,439) 1^DGPTX45 "KRN",.402,218,"AR",45.01,440) 2^DGPTX45 "KRN",.402,218,"AR",45.01,441) 3^DGPTX45 "KRN",.402,218,"AR",45.01,442) 4^DGPTX45 "KRN",.402,218,"AR",45.01,443) 5^DGPTX45 "KRN",.402,218,"DR",1,45) 40///^S X=+DGSUR; "KRN",.402,218,"DR",2,45.01) K DGPTIT S DGHOLD=$S($D(^DGPT(DGPTF,"S",DGSUR,0)):^(0),1:"");S:'$D(DGADD) DGADD=0;S:DGADD Y="@2";S:DGJUMP'[1 (DGNFLD,Y)="@2";.01;3;4;5;6;7;S:DGJUMP'[2 Y=0;@2;S DGNFLD="@30";I DGADD,$P(DGHOLD,U,8)]"" S Y="@30";8; "KRN",.402,218,"DR",2,45.01,1) I X K DGPTIT S DGNFLD="@30",Y="@800",DGPTIT(X_$C(59)_"ICD0(")="";@30;S DGNFLD="@40";I DGADD,$P(DGHOLD,U,9)]"" S Y="@40";9;I X K DGPTIT S DGNFLD="@40",Y="@800",DGPTIT(X_$C(59)_"ICD0(")="";@40;S DGNFLD="@50"; "KRN",.402,218,"DR",2,45.01,2) I DGADD,$P(DGHOLD,U,10)]"" S Y="@50";10;I X K DGPTIT S DGNFLD="@50",Y="@800",DGPTIT(X_$C(59)_"ICD0(")="";@50;S DGNFLD="@60";I DGADD,$P(DGHOLD,U,11)]"" S Y="@60";11;I X K DGPTIT S DGNFLD="@60",Y="@800",DGPTIT(X_$C(59)_"ICD0(")=""; "KRN",.402,218,"DR",2,45.01,3) @60;S DGNFLD="@70";I DGADD,$P(DGHOLD,U,12)]"" S Y="@70";12;I X K DGPTIT S DGNFLD="@70",Y="@800",DGPTIT(X_$C(59)_"ICD0(")="";@70;K DGNFLD S Y="";@800;D SCAN^DGPTSCAN I '$D(DGBPC) S Y="@899";I '$D(DGBPC(1)) S Y="@899";300.01;@899; "KRN",.402,218,"DR",2,45.01,4) K DGPTIT S Y=DGNFLD; "KRN",.402,218,"ROU") ^DGPTX4 "KRN",.402,218,"ROUOLD") DGPTX4 "MBREQ") 0 "ORD",7,.402) .402;7;;;EDEOUT^DIFROMSO(.402,DA,"",XPDA);FPRE^DIFROMSI(.402,"",XPDA);EPRE^DIFROMSI(.402,DA,$E("N",$G(XPDNEW)),XPDA,"",OLDA);;EPOST^DIFROMSI(.402,DA,"",XPDA);DEL^DIFROMSK(.402,"",%) "ORD",7,.402,0) INPUT TEMPLATE "PKG",5,-1) 1^1 "PKG",5,0) REGISTRATION^DG^PATIENT REGISTRATION, ADMISSION, DISCHARGE, EMBOSSER "PKG",5,20,0) ^9.402P^^ "PKG",5,22,0) ^9.49I^1^1 "PKG",5,22,1,0) 5.3^2930813 "PKG",5,22,1,"PAH",1,0) 757^3070730^123456810 "PRE") DG53757P "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") YES "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") YES "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") YES "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") 1 "RTN","DG53757P") 0^1^B11371575^n/a "RTN","DG53757P",1,0) DG53757P ;ALB/MRY - Add/Rename SURGICAL SPECIALTIES ; 6/4/07 11:05am "RTN","DG53757P",2,0) ;;5.3;Registration;**757**;Aug 13, 1993;Build 5 "RTN","DG53757P",3,0) ; "RTN","DG53757P",4,0) EN ; "RTN","DG53757P",5,0) S XPDABORT="" "RTN","DG53757P",6,0) I '$G(DUZ)!($G(DUZ(0))'="@")!('$G(DT))!($G(U)'="^") D G ABRT "RTN","DG53757P",7,0) . D BMES^XPDUTL("*****") "RTN","DG53757P",8,0) . D MES^XPDUTL("Your Programming variables are not set up properly.") "RTN","DG53757P",9,0) . D MES^XPDUTL("Installation aborted.") "RTN","DG53757P",10,0) W !!,">> Environment check complete and okay." "RTN","DG53757P",11,0) Q "RTN","DG53757P",12,0) ; "RTN","DG53757P",13,0) ABRT ;Abort transport, but leave in ^XTMP "RTN","DG53757P",14,0) S XPDABORT=2 Q "RTN","DG53757P",15,0) ; "RTN","DG53757P",16,0) PRE ;pre-init "RTN","DG53757P",17,0) ;kill off ^DD(45.01,3 field, refresh field found in Build "RTN","DG53757P",18,0) ;inorder to remove SCREEN "RTN","DG53757P",19,0) S DIK="^DD(45.01,",DA=3,DA(1)=45.01 "RTN","DG53757P",20,0) D ^DIK "RTN","DG53757P",21,0) Q "RTN","DG53757P",22,0) ; "RTN","DG53757P",23,0) POST ;post-init "RTN","DG53757P",24,0) N DGI,DGSPEC "RTN","DG53757P",25,0) D BMES^XPDUTL("Updating Surgical Specialty (#45.3) File.....") "RTN","DG53757P",26,0) F DGI=1:1 S DGSPEC=$P($T(SURGSP+DGI),";;",2) Q:DGSPEC="QUIT" D "RTN","DG53757P",27,0) . D SURGTS "RTN","DG53757P",28,0) Q "RTN","DG53757P",29,0) ; "RTN","DG53757P",30,0) SURGTS ;Add/Rename to new surgical specialties "RTN","DG53757P",31,0) D BMES^XPDUTL(">>>"_$P(DGSPEC,U,3)_">>>") "RTN","DG53757P",32,0) ;if oldcode exists and newcode exits, then error. "RTN","DG53757P",33,0) I $D(^DIC(45.3,"B",$P(DGSPEC,U))),$D(^DIC(45.3,"B",$P(DGSPEC,U,2))) D ERROR Q "RTN","DG53757P",34,0) ;if no oldcode, then add newcode. "RTN","DG53757P",35,0) I '$D(^DIC(45.3,"B",$P(DGSPEC,U))) D ADD "RTN","DG53757P",36,0) ;if oldcode exists, then edit oldcode to newcode. "RTN","DG53757P",37,0) I $D(^DIC(45.3,"B",$P(DGSPEC,U))) D EDIT "RTN","DG53757P",38,0) Q "RTN","DG53757P",39,0) ; "RTN","DG53757P",40,0) ERROR ; "RTN","DG53757P",41,0) D MES^XPDUTL(" Entry not added to SURGICAL SPECIALTY File (#45.3). No further updating will occur.") "RTN","DG53757P",42,0) D MES^XPDUTL(" Please contact Customer Service for assistance.") "RTN","DG53757P",43,0) Q "RTN","DG53757P",44,0) ; "RTN","DG53757P",45,0) ADD ;add surgical specialty code "RTN","DG53757P",46,0) N DIC,DIE,DGDA1,DLAYGO,DR,X,Y "RTN","DG53757P",47,0) S DIC="^DIC(45.3," "RTN","DG53757P",48,0) S DIC(0)="LX" "RTN","DG53757P",49,0) S X=$P(DGSPEC,U,2) "RTN","DG53757P",50,0) S DLAYGO=45.3 "RTN","DG53757P",51,0) D ^DIC "RTN","DG53757P",52,0) S DGDA1=Y "RTN","DG53757P",53,0) I +DGDA1=-1 D Q "RTN","DG53757P",54,0) .D MES^XPDUTL(" Entry not added to SURGICAL SPECIALTY File (#45.3). No furher updating will occur.") "RTN","DG53757P",55,0) .D MES^XPDUTL(" Please contact Customer Service for assistance.") "RTN","DG53757P",56,0) .Q "RTN","DG53757P",57,0) I $P(DGDA1,U,3)'=1&($P(Y,U,2)'=$P(DGSPEC,U,2)) D Q "RTN","DG53757P",58,0) .D MES^XPDUTL(" Entry exists in SURGICAL SPECIALTY File (#45.3), but with a different PTF Code #.") "RTN","DG53757P",59,0) .D MES^XPDUTL(" No further updating will occur. Please review entry.") "RTN","DG53757P",60,0) .Q "RTN","DG53757P",61,0) D MES^XPDUTL(" Entry "_$S($P(DGDA1,U,3)=1:"added to",1:"exists in")_" SURGICAL SPECIALTY File (#45.3).") "RTN","DG53757P",62,0) D MES^XPDUTL(" Updating SURGICAL SPECIALTY File fields.") "RTN","DG53757P",63,0) S DIE=DIC "RTN","DG53757P",64,0) S DR=".01///"_$P(DGSPEC,U,2)_";1///"_$P(DGSPEC,U,3) "RTN","DG53757P",65,0) S DA=+DGDA1 "RTN","DG53757P",66,0) D ^DIE "RTN","DG53757P",67,0) Q "RTN","DG53757P",68,0) ; "RTN","DG53757P",69,0) EDIT ;rename oldcode to newcode "RTN","DG53757P",70,0) N DA,DIE,DR "RTN","DG53757P",71,0) S DIE="^DIC(45.3," "RTN","DG53757P",72,0) S DIC(0)="X" "RTN","DG53757P",73,0) S DA=$O(^DIC(45.3,"B",$P(DGSPEC,U),"")) "RTN","DG53757P",74,0) I +DA D "RTN","DG53757P",75,0) .S DR=".01///"_$P(DGSPEC,U,2) "RTN","DG53757P",76,0) .D ^DIE "RTN","DG53757P",77,0) .D MES^XPDUTL(" Entry's code "_$P(DGSPEC,U)_" renamed to code "_$P(DGSPEC,U,2)) "RTN","DG53757P",78,0) .D MES^XPDUTL(" Updating SURGICAL SPECIALTY File fields.") "RTN","DG53757P",79,0) Q "RTN","DG53757P",80,0) SURGSP ;;OldCode^NewCode^Specialty "RTN","DG53757P",81,0) ;;500^48^CARDIAC SURGERY "RTN","DG53757P",82,0) ;;501^49^TRANSPLANTATION "RTN","DG53757P",83,0) ;;502^78^ANESTHESIOLOGY "RTN","DG53757P",84,0) ;;QUIT "UP",45,45.01,-1) 45^S "UP",45,45.01,0) 45.01 "VER") 8.0^22.0 "^DD",45,45.01,3,0) SURGICAL SPECIALTY^RP45.3'^DIC(45.3,^0;3^Q "^DD",45,45.01,3,3) Enter the surgical specialty from the available list. "^DD",45,45.01,3,21,0) ^^1^1^2920212^^ "^DD",45,45.01,3,21,1,0) This field contains the surgical specialty for this espisode of care. "^DD",45,45.01,3,"DT") 2840223 "^DD",45.3,45.3,.01,0) CODE^RNJ2,0X^^0;1^K:+X'=X!(((X>62)!(X<48))&(X'=78))!(X?.E1"."1N.N) X "^DD",45.3,45.3,.01,1,0) ^.1 "^DD",45.3,45.3,.01,1,1,0) 45.3^B "^DD",45.3,45.3,.01,1,1,1) S ^DIC(45.3,"B",$E(X,1,30),DA)="" "^DD",45.3,45.3,.01,1,1,2) K ^DIC(45.3,"B",$E(X,1,30),DA) "^DD",45.3,45.3,.01,3) Type a Number between 48 and 62, or 78 "^DD",45.3,45.3,.01,21,0) ^^2^2^3070730^ "^DD",45.3,45.3,.01,21,1,0) This field contains the code for the surgical specialty. The code is a "^DD",45.3,45.3,.01,21,2,0) number between 48 and 62, or 78. "^DD",45.3,45.3,.01,"DT") 3070730 "BLD",6669,6) ^674 **END** **END**