Released DG*5.3*813 SEQ #717 Extracted from mail message **KIDS**:DG*5.3*813^ **INSTALL NAME** DG*5.3*813 "BLD",8077,0) DG*5.3*813^REGISTRATION^0^3090824^y "BLD",8077,1,0) ^^1^1^3090824^^^ "BLD",8077,1,1,0) TREATING SPECIALTY UPDATES FOR FY10 "BLD",8077,4,0) ^9.64PA^^ "BLD",8077,6) 6^ "BLD",8077,6.3) 23 "BLD",8077,"ABPKG") n "BLD",8077,"INI") EN^DG53P813 "BLD",8077,"KRN",0) ^9.67PA^779.2^20 "BLD",8077,"KRN",.4,0) .4 "BLD",8077,"KRN",.401,0) .401 "BLD",8077,"KRN",.402,0) .402 "BLD",8077,"KRN",.403,0) .403 "BLD",8077,"KRN",.5,0) .5 "BLD",8077,"KRN",.84,0) .84 "BLD",8077,"KRN",3.6,0) 3.6 "BLD",8077,"KRN",3.8,0) 3.8 "BLD",8077,"KRN",9.2,0) 9.2 "BLD",8077,"KRN",9.8,0) 9.8 "BLD",8077,"KRN",19,0) 19 "BLD",8077,"KRN",19.1,0) 19.1 "BLD",8077,"KRN",101,0) 101 "BLD",8077,"KRN",409.61,0) 409.61 "BLD",8077,"KRN",771,0) 771 "BLD",8077,"KRN",779.2,0) 779.2 "BLD",8077,"KRN",870,0) 870 "BLD",8077,"KRN",8989.51,0) 8989.51 "BLD",8077,"KRN",8989.52,0) 8989.52 "BLD",8077,"KRN",8994,0) 8994 "BLD",8077,"KRN","B",.4,.4) "BLD",8077,"KRN","B",.401,.401) "BLD",8077,"KRN","B",.402,.402) "BLD",8077,"KRN","B",.403,.403) "BLD",8077,"KRN","B",.5,.5) "BLD",8077,"KRN","B",.84,.84) "BLD",8077,"KRN","B",3.6,3.6) "BLD",8077,"KRN","B",3.8,3.8) "BLD",8077,"KRN","B",9.2,9.2) "BLD",8077,"KRN","B",9.8,9.8) "BLD",8077,"KRN","B",19,19) "BLD",8077,"KRN","B",19.1,19.1) "BLD",8077,"KRN","B",101,101) "BLD",8077,"KRN","B",409.61,409.61) "BLD",8077,"KRN","B",771,771) "BLD",8077,"KRN","B",779.2,779.2) "BLD",8077,"KRN","B",870,870) "BLD",8077,"KRN","B",8989.51,8989.51) "BLD",8077,"KRN","B",8989.52,8989.52) "BLD",8077,"KRN","B",8994,8994) "BLD",8077,"QDEF") ^^^^^^^^^^YES "BLD",8077,"QUES",0) ^9.62^^ "BLD",8077,"REQB",0) ^9.611^^0 "INI") EN^DG53P813 "MBREQ") 0 "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^2930918 "PKG",5,22,1,"PAH",1,0) 813^3090824^33231 "PKG",5,22,1,"PAH",1,1,0) ^^1^1^3090824 "PKG",5,22,1,"PAH",1,1,1,0) TREATING SPECIALTY UPDATES FOR FY10 "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") 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","DG53P813") 0^^B53412367^n/a "RTN","DG53P813",1,0) DG53P813 ;ALB/JRC - FY10 TREATING SPECIALTIES ; 3/12/07 7:21am "RTN","DG53P813",2,0) ;;5.3;Registration;**813**;Aug 13, 1993;Build 23 "RTN","DG53P813",3,0) ; "RTN","DG53P813",4,0) Q "RTN","DG53P813",5,0) EN ;Add Treating Specialties to the SPECIALITY file (#42.4) "RTN","DG53P813",6,0) N DGI,DGERR,DGSPEC,DGIFN,DGQUES "RTN","DG53P813",7,0) S DGIFN=0 "RTN","DG53P813",8,0) ;add new treating specialties "RTN","DG53P813",9,0) F DGI=1:1 S DGSPEC=$P($T(TRSP+DGI),";;",2) Q:DGSPEC="QUIT" D "RTN","DG53P813",10,0) .D TSPEC "RTN","DG53P813",11,0) .S DGQUES=$P(DGSPEC,U,9) "RTN","DG53P813",12,0) .D FAC "RTN","DG53P813",13,0) .Q "RTN","DG53P813",14,0) ;edit existing treating specialties "RTN","DG53P813",15,0) D EDIT "RTN","DG53P813",16,0) ;inactivate existing treating specialties "RTN","DG53P813",17,0) D INACT "RTN","DG53P813",18,0) ;edit existing surgical specialties "RTN","DG53P813",19,0) ;D EDIT^DG53813R "RTN","DG53P813",20,0) Q "RTN","DG53P813",21,0) TSPEC ;Add treating specialty to SPECIALTY File (#42.4) "RTN","DG53P813",22,0) D BMES^XPDUTL(">>>"_$P(DGSPEC,U,2)_">>>") "RTN","DG53P813",23,0) N DA,DGFILE,DGMULT,DIC,DIE,DGDA1,DINUM,DLAYGO,DR,X,Y "RTN","DG53P813",24,0) S DGERR=0 "RTN","DG53P813",25,0) S DIC="^DIC(42.4," "RTN","DG53P813",26,0) S DIC(0)="LX" "RTN","DG53P813",27,0) S DINUM=$P(DGSPEC,U) "RTN","DG53P813",28,0) S X=$P(DGSPEC,U,2) "RTN","DG53P813",29,0) S DLAYGO=42.4 "RTN","DG53P813",30,0) D ^DIC "RTN","DG53P813",31,0) S (DGIFN,DGDA1)=Y "RTN","DG53P813",32,0) I +DGIFN=-1 D Q "RTN","DG53P813",33,0) .D MES^XPDUTL(" Entry not added to SPECIALTY File (#42.4). No further updating will occur.") "RTN","DG53P813",34,0) .D MES^XPDUTL(" Please contact Customer Service for assistance.") "RTN","DG53P813",35,0) .Q "RTN","DG53P813",36,0) I $P(DGIFN,U,3)'=1&(+DGIFN'=$P(DGSPEC,U)) D Q "RTN","DG53P813",37,0) .D MES^XPDUTL(" Entry exists in SPECIALTY File (#42.4), but with a different PTF Code #.") "RTN","DG53P813",38,0) .D MES^XPDUTL(" No further updating will occur. Please review entry.") "RTN","DG53P813",39,0) .S DGERR=1 "RTN","DG53P813",40,0) .Q "RTN","DG53P813",41,0) D MES^XPDUTL(" Entry "_$S($P(DGIFN,U,3)=1:"added to",1:"exists in")_" SPECIALTY File (#42.4).") "RTN","DG53P813",42,0) D MES^XPDUTL(" Updating SPECIALTY File fields.") "RTN","DG53P813",43,0) S DIE=DIC "RTN","DG53P813",44,0) S DR="1///"_$P(DGSPEC,U,3)_";3///"_$P(DGSPEC,U,4)_";4///"_$P(DGSPEC,U,5)_";5///"_$P(DGSPEC,U,6)_";6///"_$P(DGSPEC,U,7)_";7///"_$P(DGSPEC,U,10) "RTN","DG53P813",45,0) S DA=+DGIFN "RTN","DG53P813",46,0) D ^DIE "RTN","DG53P813",47,0) S DGFILE=42.4 "RTN","DG53P813",48,0) S DGMULT=10 "RTN","DG53P813",49,0) S DIC="^DIC(42.4,"_+DGIFN_",""E""," "RTN","DG53P813",50,0) D MULT "RTN","DG53P813",51,0) Q "RTN","DG53P813",52,0) FAC ;Add treating specialty to Facility Treating Specialty file (#45.7) "RTN","DG53P813",53,0) N DA,DGFILE,DGMULT,DIC,DIE,DLAYGO,DR,X,Y "RTN","DG53P813",54,0) S DIC="^DIC(45.7," "RTN","DG53P813",55,0) S DIC(0)="LXZ" "RTN","DG53P813",56,0) S DLAYGO=45.7 "RTN","DG53P813",57,0) S X=$P(DGSPEC,U,2) "RTN","DG53P813",58,0) D ^DIC "RTN","DG53P813",59,0) S DGDA1=Y "RTN","DG53P813",60,0) I +DGDA1=-1 D BMES^XPDUTL(" Entry not added to FACILITY TREATING SPECIALTY File(#45.7).") Q "RTN","DG53P813",61,0) I $P(DGDA1,U,3)'=1&($P(Y(0),U,2)'=$P(DGSPEC,U)) D Q "RTN","DG53P813",62,0) .D BMES^XPDUTL(" Entry exists in FACILITY TREATING SPECIALTY File (#45.7), but with") "RTN","DG53P813",63,0) .D MES^XPDUTL(" a different PTF Code #. No further updating will occur.") "RTN","DG53P813",64,0) .D MES^XPDUTL(" Please review entry.") "RTN","DG53P813",65,0) .Q "RTN","DG53P813",66,0) D BMES^XPDUTL(" Entry "_$S($P(DGDA1,U,3)=1:"added to",1:"exists in")_" FACILITY TREATING SPECIALTY File (#45.7).") "RTN","DG53P813",67,0) D MES^XPDUTL(" Updating SPECIALTY field...") "RTN","DG53P813",68,0) S DIE=DIC "RTN","DG53P813",69,0) S DA=+DGDA1 "RTN","DG53P813",70,0) S DR="1////"_$P(DGSPEC,U) "RTN","DG53P813",71,0) D ^DIE "RTN","DG53P813",72,0) S DGFILE=45.7 "RTN","DG53P813",73,0) S DGMULT=100 "RTN","DG53P813",74,0) S DIC="^DIC(45.7,"_+DGDA1_",""E""," "RTN","DG53P813",75,0) D MULT "RTN","DG53P813",76,0) Q "RTN","DG53P813",77,0) MULT ;Add Effective Date "RTN","DG53P813",78,0) N DA,DIE,DR "RTN","DG53P813",79,0) S DA(1)=+DGDA1 "RTN","DG53P813",80,0) S DIC(0)="LX" "RTN","DG53P813",81,0) S DIC("P")=$P(^DD(DGFILE,DGMULT,0),"^",2) "RTN","DG53P813",82,0) S X=3091001 "RTN","DG53P813",83,0) D ^DIC "RTN","DG53P813",84,0) S DA=+Y "RTN","DG53P813",85,0) I +Y=-1 D MES^XPDUTL(" Effective date not added.") Q "RTN","DG53P813",86,0) D MES^XPDUTL(" Effective date added.") "RTN","DG53P813",87,0) S DIE=DIC "RTN","DG53P813",88,0) S DR=".02///Y" "RTN","DG53P813",89,0) D ^DIE "RTN","DG53P813",90,0) Q "RTN","DG53P813",91,0) INACT ;inactivate treating specialties "RTN","DG53P813",92,0) N DA,DIE,DR,X,DGTSP "RTN","DG53P813",93,0) F DGTSP=28,29,38 D "RTN","DG53P813",94,0) . S DIC="^DIC(42.4,"_DGTSP_",""E""," "RTN","DG53P813",95,0) . S DA(1)=DGTSP "RTN","DG53P813",96,0) . S DIC(0)="LX" "RTN","DG53P813",97,0) . S DIC("P")=$P(^DD(42.4,10,0),"^",2) "RTN","DG53P813",98,0) . S X=3091001 "RTN","DG53P813",99,0) . D ^DIC "RTN","DG53P813",100,0) . S DA=+Y "RTN","DG53P813",101,0) . I +Y=-1 D BMES^XPDUTL(">>>Inactive date not added to TS code "_DGTSP_" in the Specialty file.<<<") Q "RTN","DG53P813",102,0) . D BMES^XPDUTL(">>>Inactive date added to TS code "_DGTSP_" in the Specialty file.<<<") "RTN","DG53P813",103,0) . S DIE=DIC "RTN","DG53P813",104,0) . S DR=".02///N" "RTN","DG53P813",105,0) . D ^DIE "RTN","DG53P813",106,0) . ;check for CODES in the Facility Treating Specialty File (45.7 "RTN","DG53P813",107,0) . ;add inactivation date of 10/1/2009 "RTN","DG53P813",108,0) . D BMES^XPDUTL(" ") "RTN","DG53P813",109,0) . D MES^XPDUTL(" FACILITY TREATING SPECIALTY FILE being checked to see if any entries are") "RTN","DG53P813",110,0) . D MES^XPDUTL(" pointing to "_DGTSP_". If so, they will be inactivated.>>>") "RTN","DG53P813",111,0) .N DAA F DAA=0:0 S DAA=$O(^DIC(45.7,"ASPEC",DGTSP,DAA)) Q:'DAA D "RTN","DG53P813",112,0) .. N DIE,DR,TS,X S TS="" "RTN","DG53P813",113,0) ..S TS=$P($G(^DIC(45.7,DAA,0)),"^") "RTN","DG53P813",114,0) ..S DIC="^DIC(45.7,"_DAA_",""E""," "RTN","DG53P813",115,0) ..S DA(1)=DAA "RTN","DG53P813",116,0) ..S DIC(0)="LX" "RTN","DG53P813",117,0) ..S X=3091001 "RTN","DG53P813",118,0) ..D ^DIC "RTN","DG53P813",119,0) ..S DA=+Y "RTN","DG53P813",120,0) ..I +Y=-1 D BMES^XPDUTL(" Inactive date not added to "_TS_"in the Facility Treating Specialty file.") Q "RTN","DG53P813",121,0) ..D BMES^XPDUTL(" Inactive date added to "_TS_" in the Facility Treating Specialty file.<<<") "RTN","DG53P813",122,0) ..S DIE=DIC "RTN","DG53P813",123,0) ..S DR=".02///N" "RTN","DG53P813",124,0) ..D ^DIE "RTN","DG53P813",125,0) Q "RTN","DG53P813",126,0) EDIT ;Edit treating specialties "RTN","DG53P813",127,0) ; "RTN","DG53P813",128,0) N DS,DIE,DR,DGI "RTN","DG53P813",129,0) S DIE="^DIC(42.4," "RTN","DG53P813",130,0) S DIC(0)="LX" "RTN","DG53P813",131,0) F DGI=1:1 S DGSPEC=$P($T(ETRSP+DGI),";;",2) Q:DGSPEC="QUIT" D "RTN","DG53P813",132,0) . S DGERR=0 "RTN","DG53P813",133,0) . S DA=$P(DGSPEC,U) "RTN","DG53P813",134,0) . S DR=".01///"_$P(DGSPEC,U,2)_";1///"_$P(DGSPEC,U,3)_";3///"_$P(DGSPEC,U,4)_";4///"_$P(DGSPEC,U,5)_";5///"_$P(DGSPEC,U,6)_";6///"_$P(DGSPEC,U,7) "RTN","DG53P813",135,0) . D ^DIE "RTN","DG53P813",136,0) . D BMES^XPDUTL(" ") "RTN","DG53P813",137,0) . D BMES^XPDUTL(" ") "RTN","DG53P813",138,0) . D BMES^XPDUTL(">>>"_$P(DGSPEC,U)_" code updated to "_$P(DGSPEC,U,2)_" in the Specialty file.>>>") "RTN","DG53P813",139,0) N DS,DIE,DR,DGI,DGII,DGSP,CNT,DGSPEC,DGSPEC1 "RTN","DG53P813",140,0) S DIE="^DIC(45.7," "RTN","DG53P813",141,0) S DIC(0)="LX" "RTN","DG53P813",142,0) F DGI=1:1 S DGSPEC=$P($T(ETRSP+DGI),";;",2) Q:DGSPEC="QUIT" D "RTN","DG53P813",143,0) . S DGERR=0 "RTN","DG53P813",144,0) . S DGSP=$P(DGSPEC,U) "RTN","DG53P813",145,0) . S CNT=0,DGSPEC1=0 F DGII=0:0 S DGSPEC1=$O(^DIC(45.7,"ASPEC",DGSP,DGSPEC1)) Q:'DGSPEC1 S CNT=CNT+1 D "RTN","DG53P813",146,0) .. I CNT=1 D "RTN","DG53P813",147,0) ... I $$ACTIVE^DGACT(45.7,DGSPEC1)'=1 S CNT=0 Q "RTN","DG53P813",148,0) ... S DA=DGSPEC1,DR=".01///"_$P(DGSPEC,U,2)_";99///@" "RTN","DG53P813",149,0) ... D BMES^XPDUTL(" "_$P(^DIC(45.7,DGSPEC1,0),U)_" name has been changed to "_$P(DGSPEC,U,2)_" in the Facility Treating Specialty file.") "RTN","DG53P813",150,0) ... D ^DIE "RTN","DG53P813",151,0) .. E D "RTN","DG53P813",152,0) ... S TS="" "RTN","DG53P813",153,0) ... S TS=$P($G(^DIC(45.7,DGSPEC1,0)),"^") "RTN","DG53P813",154,0) ... D BMES^XPDUTL(" Please review Facility Treating Specialty "_TS_". The entry name may need changing or entry may need inactivating since more than one entry points to "_$P(DGSPEC,U,2)_" in the Specialty file.<<<") "RTN","DG53P813",155,0) Q "RTN","DG53P813",156,0) TRSP ;PTF CODE^SPECIALTY^PRINT NAME^SERVICE^ASK PSYCH^BILLING BEDSECTION^CDR/MPCR^^QUES#^AUSTIN PTF CODE "RTN","DG53P813",157,0) ;;105^HOSPICE FOR ACUTE CARE^^MEDICINE^N^GENERAL MEDICAL CARE^1110^^^1F "RTN","DG53P813",158,0) ;;106^VASCULAR^^SURGERY^N^SURGICAL CARE^1210^^^1G "RTN","DG53P813",159,0) ;;107^MEDICAL STEP DOWN^^MEDICINE^N^GENERAL MEDICAL CARE^1110^^^1H "RTN","DG53P813",160,0) ;;108^ED OBSERVATION^^MEDICINE^N^GENERAL MEDICAL CARE^1150^^^1J "RTN","DG53P813",161,0) ;;QUIT "RTN","DG53P813",162,0) ETRSP ;;PTF CODE^SPECIALTY^PRINT NAME^SERVICE^ASK PSYCH^BILLING BEDSECTION^CDR/MPCR "RTN","DG53P813",163,0) ;;18^NEUROLOGY OBSERVATION^^MEDICINE^NO^NEUROLOGY^1151^^ "RTN","DG53P813",164,0) ;;23^SPINAL CORD INJURY OBSERVATION^^SPINAL CORD INJURY^NO^SPINAL CORD INJURY CARE^1156^^ "RTN","DG53P813",165,0) ;;24^MEDICAL OBSERVATION^^MEDICINE^NO^GENERAL MEDICAL CARE^1150^^ "RTN","DG53P813",166,0) ;;36^BLIND REHAB OBSERVATION^^REHAB MEDICINE^NO^BLIND REHABILITATION^1155^^ "RTN","DG53P813",167,0) ;;41^REHAB MEDICINE OBSERVATION^^REHAB MEDICINE^NO^REHABILITATION MEDICINE^1153^^ "RTN","DG53P813",168,0) ;;65^SURGICAL OBSERVATION^^SURGERY^NO^SURGICAL CARE^1250^^ "RTN","DG53P813",169,0) ;;94^PSYCHIATRIC OBSERVATION^^PSYCHIATRY^YES^PSYCHIATRIC CARE^1350^^ "RTN","DG53P813",170,0) ;;QUIT "RTN","DG53P813",171,0) Q "VER") 8.0^22.0 "BLD",8077,6) ^717 **END** **END**