Released DG*5.3*789 SEQ #698 Extracted from mail message **KIDS**:DG*5.3*789^ **INSTALL NAME** DG*5.3*789 "BLD",7070,0) DG*5.3*789^REGISTRATION^0^3081029^y "BLD",7070,1,0) ^^6^6^3080819^^^^ "BLD",7070,1,1,0) This patch makes field #6 USE FOR Z07 in file #38.6 IN "BLD",7070,1,2,0) INCONSISTENT DATA ELEMENTS undeditable. It also updates the "BLD",7070,1,3,0) data to correspond with the values that were sent out with the "BLD",7070,1,4,0) VHA Directive. "BLD",7070,1,5,0) "BLD",7070,1,6,0) This patch also modifies the VADPT0 routine. "BLD",7070,4,0) ^9.64PA^38.6^1 "BLD",7070,4,38.6,0) 38.6 "BLD",7070,4,38.6,2,0) ^9.641^38.6^1 "BLD",7070,4,38.6,2,38.6,0) INCONSISTENT DATA ELEMENTS (File-top level) "BLD",7070,4,38.6,2,38.6,1,0) ^9.6411^6^1 "BLD",7070,4,38.6,2,38.6,1,6,0) USE FOR Z07 CHECK "BLD",7070,4,38.6,222) y^y^p^^^^n^^n "BLD",7070,4,38.6,224) "BLD",7070,4,"APDD",38.6,38.6) "BLD",7070,4,"APDD",38.6,38.6,6) "BLD",7070,4,"B",38.6,38.6) "BLD",7070,6.3) 7 "BLD",7070,"ABPKG") n "BLD",7070,"INI") DG53789P "BLD",7070,"INIT") "BLD",7070,"KRN",0) ^9.67PA^8989.52^19 "BLD",7070,"KRN",.4,0) .4 "BLD",7070,"KRN",.4,"NM",0) ^9.68A^^ "BLD",7070,"KRN",.401,0) .401 "BLD",7070,"KRN",.402,0) .402 "BLD",7070,"KRN",.403,0) .403 "BLD",7070,"KRN",.5,0) .5 "BLD",7070,"KRN",.84,0) .84 "BLD",7070,"KRN",3.6,0) 3.6 "BLD",7070,"KRN",3.8,0) 3.8 "BLD",7070,"KRN",9.2,0) 9.2 "BLD",7070,"KRN",9.8,0) 9.8 "BLD",7070,"KRN",9.8,"NM",0) ^9.68A^1^1 "BLD",7070,"KRN",9.8,"NM",1,0) VADPT0^^0^B12664497 "BLD",7070,"KRN",9.8,"NM","B","VADPT0",1) "BLD",7070,"KRN",19,0) 19 "BLD",7070,"KRN",19,"NM",0) ^9.68A^^ "BLD",7070,"KRN",19.1,0) 19.1 "BLD",7070,"KRN",101,0) 101 "BLD",7070,"KRN",409.61,0) 409.61 "BLD",7070,"KRN",771,0) 771 "BLD",7070,"KRN",870,0) 870 "BLD",7070,"KRN",8989.51,0) 8989.51 "BLD",7070,"KRN",8989.52,0) 8989.52 "BLD",7070,"KRN",8994,0) 8994 "BLD",7070,"KRN","B",.4,.4) "BLD",7070,"KRN","B",.401,.401) "BLD",7070,"KRN","B",.402,.402) "BLD",7070,"KRN","B",.403,.403) "BLD",7070,"KRN","B",.5,.5) "BLD",7070,"KRN","B",.84,.84) "BLD",7070,"KRN","B",3.6,3.6) "BLD",7070,"KRN","B",3.8,3.8) "BLD",7070,"KRN","B",9.2,9.2) "BLD",7070,"KRN","B",9.8,9.8) "BLD",7070,"KRN","B",19,19) "BLD",7070,"KRN","B",19.1,19.1) "BLD",7070,"KRN","B",101,101) "BLD",7070,"KRN","B",409.61,409.61) "BLD",7070,"KRN","B",771,771) "BLD",7070,"KRN","B",870,870) "BLD",7070,"KRN","B",8989.51,8989.51) "BLD",7070,"KRN","B",8989.52,8989.52) "BLD",7070,"KRN","B",8994,8994) "BLD",7070,"PRET") "BLD",7070,"QUES",0) ^9.62^^ "BLD",7070,"REQB",0) ^9.611^1^1 "BLD",7070,"REQB",1,0) DG*5.3*689^2 "BLD",7070,"REQB","B","DG*5.3*689",1) "FIA",38.6) INCONSISTENT DATA ELEMENTS "FIA",38.6,0) ^DGIN(38.6, "FIA",38.6,0,0) 38.6s "FIA",38.6,0,1) y^y^p^^^^n^^n "FIA",38.6,0,10) "FIA",38.6,0,11) "FIA",38.6,0,"RLRO") "FIA",38.6,0,"VR") 5.3^DG "FIA",38.6,38.6) 1 "FIA",38.6,38.6,6) "INI") DG53789P "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 "PKG",5,22,1,"PAH",1,0) 789^3081029^1258 "PKG",5,22,1,"PAH",1,1,0) ^^6^6^3081029 "PKG",5,22,1,"PAH",1,1,1,0) This patch makes field #6 USE FOR Z07 in file #38.6 IN "PKG",5,22,1,"PAH",1,1,2,0) INCONSISTENT DATA ELEMENTS undeditable. It also updates the "PKG",5,22,1,"PAH",1,1,3,0) data to correspond with the values that were sent out with the "PKG",5,22,1,"PAH",1,1,4,0) VHA Directive. "PKG",5,22,1,"PAH",1,1,5,0) "PKG",5,22,1,"PAH",1,1,6,0) This patch also modifies the VADPT0 routine. "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") 2 "RTN","DG53789P") 0^^B9748776^n/a "RTN","DG53789P",1,0) DG53789P ;ALB/MAF - INCONSISTANCY CHECKER UPDATE ROUTINE; 13 December 1996 "RTN","DG53789P",2,0) ;;5.3;Registration;**789**;JUL 28, 2008;Build 7 "RTN","DG53789P",3,0) ; "RTN","DG53789P",4,0) ; This routine checks inconsistency field (#6) Use for Z07 to make sure it is set correctly for all the entries in file 38.6. If the value is not set to the directive value, this routine will reset the value and notify the user of the change. "RTN","DG53789P",5,0) ; "RTN","DG53789P",6,0) EN ; check values for field #6 in file 38.6 "RTN","DG53789P",7,0) N DA,DIE,DR,DIC,DGI,DGJ,DGX,X,Y,ENTRY,VALUE,VALDA,VAL6,VALNODE,DGFLAG "RTN","DG53789P",8,0) S DGFLAG=0 "RTN","DG53789P",9,0) D BMES^XPDUTL(">>>Checking all entries in file 38.6 for correct values in field #6 Use for Z07...") "RTN","DG53789P",10,0) F DGI=1:1 S DGX=$P($T(DATA+DGI),";;",2) Q:DGX="QUIT" S DGJ=0 F S DGJ=DGJ+1 S VALUE=$P(DGX,"^",DGJ) Q:VALUE="" S VALDA=$P(VALUE,";",1),VAL6=$P(VALUE,";",2) I $D(^DGIN(38.6,VALDA,0)) D "RTN","DG53789P",11,0) . S VALNODE=$G(^DGIN(38.6,VALDA,0)) "RTN","DG53789P",12,0) . I $P(VALNODE,"^",6)=VAL6 Q "RTN","DG53789P",13,0) . S DIE="^DGIN(38.6," "RTN","DG53789P",14,0) . S DA=VALDA,DR="6////^S X=VAL6" "RTN","DG53789P",15,0) . D ^DIE "RTN","DG53789P",16,0) . S ENTRY=$J("Entry "_VALDA_" : ",13) "RTN","DG53789P",17,0) . D MES^XPDUTL(ENTRY_$P(VALNODE,"^",1)_" set from "_$S($P(VALNODE,"^",6)=1:"YES",$P(VALNODE,"^",6)=0:"NO",1:"NULL")_" to "_$S(VAL6=1:"YES",1:"NO")) "RTN","DG53789P",18,0) . I DGFLAG=0 S DGFLAG=1 "RTN","DG53789P",19,0) . Q "RTN","DG53789P",20,0) I 'DGFLAG D MES^XPDUTL(" All values agree with those in VHA Directive 2008-031 ... nothing changed.") "RTN","DG53789P",21,0) ; "RTN","DG53789P",22,0) ; "RTN","DG53789P",23,0) DATA ; lines to stuff in values (field////value) "RTN","DG53789P",24,0) ;;1;0^2;0^3;0^4;1^5;0^6;0^7;1^8;0^9;1^10;0^11;1^12;0^13;1^14;0^15;1^16;1^17;0^18;0^19;1^20;0^21;0^22;0^23;0^24;1^25;0^26;0^27;0^28;0^29;1^30;1^31;1^32;0^33;0^34;1^35;0^36;0^37;0^38;0^39;0^40;0^41;0^42;0^43;0^44;0^45;0^46;0^47;0^48;0 "RTN","DG53789P",25,0) ;;49;0^50;0^51;0^52;0^53;0^54;0^55;0^56;0^57;0^58;0^59;0^60;1^61;0^62;0^63;0^64;0^65;0^66;0^67;0^68;0^69;0^70;0^71;0^72;0^73;0^74;0^75;0^76;0^77;0^78;0^79;0^80;0^81;0^82;0^83;1^84;0^85;1^86;1^87;0^99;0^301;1^303;1^304;1^306;0^307;0 "RTN","DG53789P",26,0) ;;308;1^309;1^310;1^312;1^401;1^402;1^403;1^406;1^407;1^409;0^411;1^501;1^502;1^503;1^504;1^505;1^506;1^507;1^508;1^509;1^510;1^511;1^516;1^517;1^701;1^702;1^703;1^704;1^705;1^706;1^707;1^708;1^709;1^710;1^711;1^712;1^713;1^714;1 "RTN","DG53789P",27,0) ;;715;1^716;1^717;1^718;0^719;1^720;1^723;1^724;1^725;1^726;1 "RTN","DG53789P",28,0) ;;QUIT "RTN","VADPT0") 0^1^B12664497^B12629835 "RTN","VADPT0",1,0) VADPT0 ;ALB/MRL/MJK - PATIENT VARIABLE ROUTINE DRIVER, CONT.; 12 DEC 1988 "RTN","VADPT0",2,0) ;;5.3;Registration;**343,342,415,489,498,528,689,789**;Aug 13, 1993;Build 7 "RTN","VADPT0",3,0) ; "RTN","VADPT0",4,0) ;Initialize variables "RTN","VADPT0",5,0) N I1 "RTN","VADPT0",6,0) S U="^" D DT^DICRW:'$D(DT) "RTN","VADPT0",7,0) S VAERR=$S('$D(DFN)#2:1,'$D(^DPT(DFN,0)):1,1:0) "RTN","VADPT0",8,0) S Y=VAN'=13 I Y,$D(VAROOT)'[0,VAROOT]"" S Y=0,VAV=VAROOT K @VAV "RTN","VADPT0",9,0) I Y S:$S(VAN>9:1,'$D(VAHOW):0,1:VAHOW[2) VAV="^UTILITY("_""""_VAV_""""_","_$J_")" "RTN","VADPT0",10,0) D @VAN "RTN","VADPT0",11,0) Q K X,Y,VAC,VAS,VAV,VAW,VAN,I,VAX,VAZ Q "RTN","VADPT0",12,0) ; "RTN","VADPT0",13,0) INIT ; -- determine #'s or names then init array "RTN","VADPT0",14,0) ; "RTN","VADPT0",15,0) S VAS="1^2^3^4^5^6^7^8^9^10^11^12^13^14^15^16^17^18^19^20^21^22^23^24^25" "RTN","VADPT0",16,0) I VAN<10,$D(VAHOW),VAHOW[1 S VAS=$P($T(SS+VAN),";;",2) "RTN","VADPT0",17,0) I $D(VAN(1)) F I=1:1:VAN(1) S @VAV@($P(VAS,"^",I))="" "RTN","VADPT0",18,0) Q "RTN","VADPT0",19,0) ; "RTN","VADPT0",20,0) 1 ; -- [DEM] demos "RTN","VADPT0",21,0) D C1,INIT I 'VAERR D 1^VADPT1,13 Q "RTN","VADPT0",22,0) ; "RTN","VADPT0",23,0) 2 ; -- [OPD] other pt vars "RTN","VADPT0",24,0) D C2,INIT,2^VADPT1:'VAERR Q "RTN","VADPT0",25,0) ; "RTN","VADPT0",26,0) 3 ; -- [ADD] current address "RTN","VADPT0",27,0) D C3,INIT,3^VADPT1:'VAERR Q "RTN","VADPT0",28,0) ; "RTN","VADPT0",29,0) 4 ; -- [OAD] other pt vars "RTN","VADPT0",30,0) D C4,INIT,4^VADPT1:'VAERR Q "RTN","VADPT0",31,0) ; "RTN","VADPT0",32,0) 5 ; -- [INP] inpt data -v5 "RTN","VADPT0",33,0) D C5,INIT,5^VADPT2:'VAERR Q "RTN","VADPT0",34,0) ; "RTN","VADPT0",35,0) 6 ; -- [IN5] inpt data v5 "RTN","VADPT0",36,0) D C6,INIT F I=13:1:17 F I1=1:1:7 S @VAV@($P(VAS,"^",I),I1)="" "RTN","VADPT0",37,0) F I=1:1:3 S @VAV@($P(VAS,"^",19),I)="" "RTN","VADPT0",38,0) D 6^VADPT3:'VAERR Q "RTN","VADPT0",39,0) ; "RTN","VADPT0",40,0) 7 ; -- [ELIG] elig data "RTN","VADPT0",41,0) D C7,INIT F I=1:1:6 S @VAV@($P(VAS,"^",5),I)="" "RTN","VADPT0",42,0) D 7^VADPT4:'VAERR Q "RTN","VADPT0",43,0) ; "RTN","VADPT0",44,0) 8 ; -- [MB] $ benefits "RTN","VADPT0",45,0) D C8,INIT D 8^VADPT4:'VAERR Q "RTN","VADPT0",46,0) ; "RTN","VADPT0",47,0) 9 ; -- [SVC] service data "RTN","VADPT0",48,0) D C9,INIT F I=1:1:9 S @VAV@($P(VAS,"^",I),1)="",@VAV@($P(VAS,"^",I),2)="" "RTN","VADPT0",49,0) F I=11:1:13 S @VAV@($P(VAS,"^",I))=0 "RTN","VADPT0",50,0) S @VAV@($P(VAS,"^",4),3)="",@VAV@($P(VAS,"^",5),3)="" "RTN","VADPT0",51,0) F I=2,6,7,8 F I1=3,4,5 S @VAV@($P(VAS,"^",I),I1)="" "RTN","VADPT0",52,0) D 9^VADPT4:'VAERR Q "RTN","VADPT0",53,0) ; "RTN","VADPT0",54,0) 10 ; -- [REG] registration data "RTN","VADPT0",55,0) D C10,INIT D 10^VADPT5:'VAERR Q "RTN","VADPT0",56,0) ; "RTN","VADPT0",57,0) 11 ; -- [SDE] clinic enrollment data "RTN","VADPT0",58,0) D C11,INIT D 11^VADPT5:'VAERR Q "RTN","VADPT0",59,0) ; "RTN","VADPT0",60,0) 12 ; -- [SDA] appt data "RTN","VADPT0",61,0) D C12,INIT D 12^VADPT5:'VAERR Q "RTN","VADPT0",62,0) ; "RTN","VADPT0",63,0) 13 ; -- [PID] pt id's "RTN","VADPT0",64,0) S (VA("PID"),VA("BID"))="" D 13^VADPT6:'VAERR Q "RTN","VADPT0",65,0) ; "RTN","VADPT0",66,0) KVAR ; kill all vadpt data "RTN","VADPT0",67,0) K VAN "RTN","VADPT0",68,0) C1 K ^UTILITY("VADM",$J),VADM Q:$D(VAN) "RTN","VADPT0",69,0) C2 K ^UTILITY("VAPD",$J),VAPD Q:$D(VAN) "RTN","VADPT0",70,0) C3 K X S:$D(VAPA("P")) X("P")=VAPA("P") "RTN","VADPT0",71,0) S:$D(VAPA("CD")) X("CD")=VAPA("CD") "RTN","VADPT0",72,0) K ^UTILITY("VAPA",$J),VAPA "RTN","VADPT0",73,0) S:$D(X("P")) VAPA("P")=X("P") K X("P") "RTN","VADPT0",74,0) S:$D(X("CD")) VAPA("CD")=X("CD") K X Q:$D(VAN) "RTN","VADPT0",75,0) C4 K X S:$D(VAOA("A")) X("A")=VAOA("A") "RTN","VADPT0",76,0) K ^UTILITY("VAOA",$J),VAOA "RTN","VADPT0",77,0) S:$D(X("A")) VAOA("A")=X("A") K X Q:$D(VAN) "RTN","VADPT0",78,0) C5 K ^UTILITY("VAIN",$J),VAIN Q:$D(VAN) "RTN","VADPT0",79,0) C6 K X F I="D","E","L","M","V" I $D(VAIP(I)) S X(I)=VAIP(I) "RTN","VADPT0",80,0) S Y=$S('$D(VAIP("V")):"VAIP",VAIP("V")'?1A.E:"VAIP",1:VAIP("V")) K ^UTILITY(Y,$J),@Y "RTN","VADPT0",81,0) F I="D","E","L","M","V" I $D(X(I)) S VAIP(I)=X(I) "RTN","VADPT0",82,0) K X Q:$D(VAN) "RTN","VADPT0",83,0) C7 K ^UTILITY("VAEL",$J),VAEL Q:$D(VAN) "RTN","VADPT0",84,0) C8 K ^UTILITY("VAMB",$J),VAMB Q:$D(VAN) "RTN","VADPT0",85,0) C9 K ^UTILITY("VASV",$J),VASV Q:$D(VAN) "RTN","VADPT0",86,0) C10 K ^UTILITY("VARP",$J) Q:$D(VAN) "RTN","VADPT0",87,0) C11 K ^UTILITY("VAEN",$J) Q:$D(VAN) "RTN","VADPT0",88,0) C12 K ^UTILITY("VASD",$J) Q "RTN","VADPT0",89,0) C13 Q "RTN","VADPT0",90,0) ; "RTN","VADPT0",91,0) SS ; 1^ 2^ 3^ 4^ 5^ 6^ 7^ 8^ 9^10^11^12^13^14^15^16^17^18^19^20^21^22^23^24^25 "RTN","VADPT0",92,0) ;;NM^SS^DB^AG^SX^EX^RE^RA^RP^MS^ET^RC "RTN","VADPT0",93,0) ;;BC^BS^FN^MN^MM^OC^ES "RTN","VADPT0",94,0) ;;L1^L2^L3^CI^ST^ZP^CO^PN^TS^TE^Z4^CCA^CL1^CL2^CL3^CCI^CST^CZP^CCO^CCS^CCE^CTY "RTN","VADPT0",95,0) ;;L1^L2^L3^CI^ST^ZP^CO^PN^NM^RE^Z4 "RTN","VADPT0",96,0) ;;AN^DR^TS^WL^RB^BS^AD^AT^AF^PT^AP "RTN","VADPT0",97,0) ;;MN^TT^MD^MT^WL^RB^DR^TS^MF^BS^RD^PT^AN^LN^PN^NN^DN^AP^FD "RTN","VADPT0",98,0) ;;EL^PS^SC^VT^IN^TY^CN^ES^MT "RTN","VADPT0",99,0) ;;AA^HB^SS^PE^MR^SI^DI^OR^GI "RTN","VADPT0",100,0) ;;VN^AO^IR^PW^CS^S1^S2^S3^PH^CV^OIF^OEF^UNK "VER") 8.0^22.0 "^DD",38.6,38.6,6,0) USE FOR Z07 CHECK^SI^0:NO;1:YES;^0;6^Q "^DD",38.6,38.6,6,23,0) ^.001^1^1^3081028^^ "^DD",38.6,38.6,6,23,1,0) "^DD",38.6,38.6,6,"DT") 3081028 "BLD",7070,6) ^698 **END** **END**