Released DG*5.3*892 SEQ #793 Extracted from mail message **KIDS**:DG*5.3*892^ **INSTALL NAME** DG*5.3*892 "BLD",9731,0) DG*5.3*892^REGISTRATION^0^3150306^y "BLD",9731,1,0) ^^6^6^3150306^ "BLD",9731,1,1,0) "BLD",9731,1,2,0) Patch DG*5.3*892 addresses 3 issues: "BLD",9731,1,3,0) "BLD",9731,1,4,0) 1.) Undefined error when entering Confidential Address "BLD",9731,1,5,0) 2.) PRF Assignment Action Not Linked Report issue "BLD",9731,1,6,0) 3.) Documentation change needed for MISSING PATIENT PRF "BLD",9731,4,0) ^9.64PA^^ "BLD",9731,6.3) 9 "BLD",9731,"ABPKG") n "BLD",9731,"INID") ^n "BLD",9731,"INIT") "BLD",9731,"KRN",0) ^9.67PA^779.2^20 "BLD",9731,"KRN",.4,0) .4 "BLD",9731,"KRN",.4,"NM",0) ^9.68A^^ "BLD",9731,"KRN",.401,0) .401 "BLD",9731,"KRN",.402,0) .402 "BLD",9731,"KRN",.403,0) .403 "BLD",9731,"KRN",.5,0) .5 "BLD",9731,"KRN",.84,0) .84 "BLD",9731,"KRN",3.6,0) 3.6 "BLD",9731,"KRN",3.8,0) 3.8 "BLD",9731,"KRN",9.2,0) 9.2 "BLD",9731,"KRN",9.8,0) 9.8 "BLD",9731,"KRN",9.8,"NM",0) ^9.68A^3^2 "BLD",9731,"KRN",9.8,"NM",2,0) DGPFRAL1^^0^B80104203 "BLD",9731,"KRN",9.8,"NM",3,0) DGREGTZL^^0^B51269802 "BLD",9731,"KRN",9.8,"NM","B","DGPFRAL1",2) "BLD",9731,"KRN",9.8,"NM","B","DGREGTZL",3) "BLD",9731,"KRN",19,0) 19 "BLD",9731,"KRN",19,"NM",0) ^9.68A^^ "BLD",9731,"KRN",19.1,0) 19.1 "BLD",9731,"KRN",101,0) 101 "BLD",9731,"KRN",409.61,0) 409.61 "BLD",9731,"KRN",771,0) 771 "BLD",9731,"KRN",779.2,0) 779.2 "BLD",9731,"KRN",870,0) 870 "BLD",9731,"KRN",8989.51,0) 8989.51 "BLD",9731,"KRN",8989.52,0) 8989.52 "BLD",9731,"KRN",8994,0) 8994 "BLD",9731,"KRN","B",.4,.4) "BLD",9731,"KRN","B",.401,.401) "BLD",9731,"KRN","B",.402,.402) "BLD",9731,"KRN","B",.403,.403) "BLD",9731,"KRN","B",.5,.5) "BLD",9731,"KRN","B",.84,.84) "BLD",9731,"KRN","B",3.6,3.6) "BLD",9731,"KRN","B",3.8,3.8) "BLD",9731,"KRN","B",9.2,9.2) "BLD",9731,"KRN","B",9.8,9.8) "BLD",9731,"KRN","B",19,19) "BLD",9731,"KRN","B",19.1,19.1) "BLD",9731,"KRN","B",101,101) "BLD",9731,"KRN","B",409.61,409.61) "BLD",9731,"KRN","B",771,771) "BLD",9731,"KRN","B",779.2,779.2) "BLD",9731,"KRN","B",870,870) "BLD",9731,"KRN","B",8989.51,8989.51) "BLD",9731,"KRN","B",8989.52,8989.52) "BLD",9731,"KRN","B",8994,8994) "BLD",9731,"QDEF") ^^^^NO^^^^NO^^YES "BLD",9731,"QUES",0) ^9.62^^ "BLD",9731,"REQB",0) ^9.611^2^2 "BLD",9731,"REQB",1,0) DG*5.3*650^2 "BLD",9731,"REQB",2,0) DG*5.3*851^2 "BLD",9731,"REQB","B","DG*5.3*650",1) "BLD",9731,"REQB","B","DG*5.3*851",2) "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) 892^3150306 "PKG",5,22,1,"PAH",1,1,0) ^^6^6^3150306 "PKG",5,22,1,"PAH",1,1,1,0) "PKG",5,22,1,"PAH",1,1,2,0) Patch DG*5.3*892 addresses 3 issues: "PKG",5,22,1,"PAH",1,1,3,0) "PKG",5,22,1,"PAH",1,1,4,0) 1.) Undefined error when entering Confidential Address "PKG",5,22,1,"PAH",1,1,5,0) 2.) PRF Assignment Action Not Linked Report issue "PKG",5,22,1,"PAH",1,1,6,0) 3.) Documentation change needed for MISSING PATIENT PRF "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") 2 "RTN","DGPFRAL1") 0^2^B80104203^B71862269 "RTN","DGPFRAL1",1,0) DGPFRAL1 ;ALB/RBS - PRF ACTION NOT LINKED REPORT CONT. ; 10/12/05 2:48pm "RTN","DGPFRAL1",2,0) ;;5.3;Registration;**554,650,892**;Aug 13, 1993;Build 9 "RTN","DGPFRAL1",3,0) ; "RTN","DGPFRAL1",4,0) ;This routine will be used to display or print all of the patient "RTN","DGPFRAL1",5,0) ;assignment history records that are not linked to a progress note. "RTN","DGPFRAL1",6,0) ; "RTN","DGPFRAL1",7,0) ; Input: The following sort array contains the report parameters: "RTN","DGPFRAL1",8,0) ; DGSORT("DGCAT") = Flag Category to report on "RTN","DGPFRAL1",9,0) ; = 1:National, 2:Local, 3:Both "RTN","DGPFRAL1",10,0) ; DGSORT("DGBEG") = Beginning date to report on "RTN","DGPFRAL1",11,0) ; DGSORT("DGEND") = Ending date to report on "RTN","DGPFRAL1",12,0) ; "RTN","DGPFRAL1",13,0) ; Output: A formatted report of patient Assignment History Actions "RTN","DGPFRAL1",14,0) ; that are not linked to a TIU Progress Note. "RTN","DGPFRAL1",15,0) ; "RTN","DGPFRAL1",16,0) ;- no direct entry "RTN","DGPFRAL1",17,0) QUIT "RTN","DGPFRAL1",18,0) ; "RTN","DGPFRAL1",19,0) START ; compile and print report "RTN","DGPFRAL1",20,0) I $E(IOST)="C" D WAIT^DICD "RTN","DGPFRAL1",21,0) N DGLIST ;temp global name used for report list "RTN","DGPFRAL1",22,0) S DGLIST=$NA(^TMP("DGPFRAL1",$J)) "RTN","DGPFRAL1",23,0) K @DGLIST "RTN","DGPFRAL1",24,0) D LOOP(.DGSORT,DGLIST) "RTN","DGPFRAL1",25,0) D PRINT(.DGSORT,DGLIST) "RTN","DGPFRAL1",26,0) K @DGLIST "RTN","DGPFRAL1",27,0) D EXIT "RTN","DGPFRAL1",28,0) Q "RTN","DGPFRAL1",29,0) ; "RTN","DGPFRAL1",30,0) LOOP(DGSORT,DGLIST) ;use sort var's for record searching to build list "RTN","DGPFRAL1",31,0) ; Input: "RTN","DGPFRAL1",32,0) ; DGSORT - array of user selected report parameters "RTN","DGPFRAL1",33,0) ; DGLIST - temp global name "RTN","DGPFRAL1",34,0) ; "RTN","DGPFRAL1",35,0) ; Output: "RTN","DGPFRAL1",36,0) ; ^TMP("DGPFRAL1",$J) - temp global containing report output "RTN","DGPFRAL1",37,0) ; "RTN","DGPFRAL1",38,0) N DGBEG ;beginning date "RTN","DGPFRAL1",39,0) N DGC ;var used to check which category is being reported on "RTN","DGPFRAL1",40,0) N DGCAT ;flag category "RTN","DGPFRAL1",41,0) N DGCATG ;category 1 or 2 "RTN","DGPFRAL1",42,0) N DGCNT ;flag counter "RTN","DGPFRAL1",43,0) N DGDFN ;pointer to patient being reported on "RTN","DGPFRAL1",44,0) N DGDFNLST ;array of dfn's assigned to the flag "RTN","DGPFRAL1",45,0) N DGEND ;ending date "RTN","DGPFRAL1",46,0) N DGHIENS ;array subscripted by assignment history date "RTN","DGPFRAL1",47,0) N DGIEN ;assignment ien "RTN","DGPFRAL1",48,0) N DGPAT ;patient data array "RTN","DGPFRAL1",49,0) N DGPFA ;assignment data array "RTN","DGPFRAL1",50,0) N DGQ ;quit var "RTN","DGPFRAL1",51,0) N DGSUB ;loop flag "RTN","DGPFRAL1",52,0) N DGX ;loop var "RTN","DGPFRAL1",53,0) ; "RTN","DGPFRAL1",54,0) ; setup variables equal to user input parameter subscripts "RTN","DGPFRAL1",55,0) ; "DGCAT", "DGBEG", "DGEND" "RTN","DGPFRAL1",56,0) S DGX="" F S DGX=$O(DGSORT(DGX)) Q:DGX="" S @DGX=DGSORT(DGX) "RTN","DGPFRAL1",57,0) S DGC=$S(+DGCAT=3:0,1:+DGCAT) "RTN","DGPFRAL1",58,0) S:DGC DGC=$S(DGC=1:26.15,1:26.11) "RTN","DGPFRAL1",59,0) ; "RTN","DGPFRAL1",60,0) ; loop assignment variable pointer flag x-ref file to run report "RTN","DGPFRAL1",61,0) S (DGDFN,DGIEN)="",(DGQ,DGSUB,DGCNT)=0 "RTN","DGPFRAL1",62,0) F S DGSUB=$O(^DGPF(26.13,"AFLAG",DGSUB)) Q:DGSUB="" D Q:DGQ "RTN","DGPFRAL1",63,0) . I DGC,DGSUB'[DGC Q ;not correct file based on category "RTN","DGPFRAL1",64,0) . S DGCATG=$S(DGSUB[26.15:1,1:2) "RTN","DGPFRAL1",65,0) . K DGDFNLST "RTN","DGPFRAL1",66,0) . S DGCNT=$$ASGNCNT^DGPFLF6(DGSUB,.DGDFNLST) "RTN","DGPFRAL1",67,0) . Q:'DGCNT "RTN","DGPFRAL1",68,0) . S DGDFN="" "RTN","DGPFRAL1",69,0) . F S DGDFN=$O(DGDFNLST(DGDFN)) Q:DGDFN="" D "RTN","DGPFRAL1",70,0) . . S DGIEN=$G(DGDFNLST(DGDFN)) Q:DGIEN="" "RTN","DGPFRAL1",71,0) . . ; get assignment record "RTN","DGPFRAL1",72,0) . . K DGPFA "RTN","DGPFRAL1",73,0) . . Q:'$$GETASGN^DGPFAA(DGIEN,.DGPFA) "RTN","DGPFRAL1",74,0) . . ; check if calling site is owner site "RTN","DGPFRAL1",75,0) . . Q:'$$ISDIV^DGPFUT($P(DGPFA("OWNER"),U)) "RTN","DGPFRAL1",76,0) . . ; "RTN","DGPFRAL1",77,0) . . ;filter patient when last action is ENTERED IN ERROR "RTN","DGPFRAL1",78,0) . . Q:$$ENTINERR(DGIEN) "RTN","DGPFRAL1",79,0) . . ; "RTN","DGPFRAL1",80,0) . . ;action ien array subscripted by assignment history date "RTN","DGPFRAL1",81,0) . . K DGHIENS "RTN","DGPFRAL1",82,0) . . Q:'$$GETALLDT^DGPFAAH(DGIEN,.DGHIENS) "RTN","DGPFRAL1",83,0) . . ; check if any Action's fall within the Begin and End dates "RTN","DGPFRAL1",84,0) . . I $P($O(DGHIENS("")),".")'>DGEND&($P($O(DGHIENS(""),-1),".")'DGEND) K DGHIENS(DGX) "RTN","DGPFRAL1",88,0) . . . Q:'$O(DGHIENS("")) "RTN","DGPFRAL1",89,0) . . . ; "RTN","DGPFRAL1",90,0) . . . ; get patient demographics "RTN","DGPFRAL1",91,0) . . . K DGPAT "RTN","DGPFRAL1",92,0) . . . Q:'$$GETPAT^DGPFUT2(DGDFN,.DGPAT) "RTN","DGPFRAL1",93,0) . . . ; "RTN","DGPFRAL1",94,0) . . . ; call to build temp global "RTN","DGPFRAL1",95,0) . . . D BLDTMP(.DGPFA,.DGPAT,.DGHIENS,DGCATG,DGLIST) "RTN","DGPFRAL1",96,0) ; "RTN","DGPFRAL1",97,0) Q "RTN","DGPFRAL1",98,0) ; "RTN","DGPFRAL1",99,0) BLDTMP(DGPFA,DGPAT,DGHIENS,DGCATG,DGLIST) ; list global builder "RTN","DGPFRAL1",100,0) ; Input: "RTN","DGPFRAL1",101,0) ; DGPFA - array of assignment record data "RTN","DGPFRAL1",102,0) ; DGPAT - array of patient demographics "RTN","DGPFRAL1",103,0) ; DGHIENS - array of history action IEN's sorted by d/t "RTN","DGPFRAL1",104,0) ; DGCATG - category of flag 1=National, 2=Local "RTN","DGPFRAL1",105,0) ; DGLIST - temp global name used for report list "RTN","DGPFRAL1",106,0) ; "RTN","DGPFRAL1",107,0) ; Output: "RTN","DGPFRAL1",108,0) ; ^TMP("DGPFRFA1",$J) - temp global containing report output "RTN","DGPFRAL1",109,0) ; "RTN","DGPFRAL1",110,0) N DGACTDT ;initial entry date "RTN","DGPFRAL1",111,0) N DGFGNM ;flag name "RTN","DGPFRAL1",112,0) N DGHIEN ;assignment ien "RTN","DGPFRAL1",113,0) N DGLINE ;report detail line "RTN","DGPFRAL1",114,0) N DGLNCNT ;unique subscript counter "RTN","DGPFRAL1",115,0) N DGPDFN ;pointer to patient "RTN","DGPFRAL1",116,0) N DGPFAH ;assignment history record data "RTN","DGPFRAL1",117,0) N DGPNM ;patient name "RTN","DGPFRAL1",118,0) N DGFLAG ;change of assignment flag "RTN","DGPFRAL1",119,0) ; "RTN","DGPFRAL1",120,0) ; Check to see if this was a change of assignment "RTN","DGPFRAL1",121,0) S DGFLAG=0 "RTN","DGPFRAL1",122,0) D FLGXFER "RTN","DGPFRAL1",123,0) ; "RTN","DGPFRAL1",124,0) ; loop all assignment history ien's "RTN","DGPFRAL1",125,0) S DGHIEN="",DGLNCNT=0 "RTN","DGPFRAL1",126,0) F S DGHIEN=$O(DGHIENS(DGHIEN)) Q:DGHIEN="" D "RTN","DGPFRAL1",127,0) . ; get assignment history record "RTN","DGPFRAL1",128,0) . K DGPFAH "RTN","DGPFRAL1",129,0) . Q:'$$GETHIST^DGPFAAH(DGHIENS(DGHIEN),.DGPFAH) "RTN","DGPFRAL1",130,0) . Q:+$G(DGPFAH("TIULINK")) ;progress note pointer is setup "RTN","DGPFRAL1",131,0) . Q:+$G(DGPFAH("ACTION"))=5 ;don't report on ENTERED IN ERROR action "RTN","DGPFRAL1",132,0) . S DGACTDT=$$FDATE^VALM1(+DGPFAH("ASSIGNDT")) "RTN","DGPFRAL1",133,0) . I DGFLAG I +DGPFAH("ASSIGNDT")'>DGFLAG Q ; Quit if < assignment chg "RTN","DGPFRAL1",134,0) . S DGPNM=DGPAT("NAME") "RTN","DGPFRAL1",135,0) . S:DGPNM']"" DGPNM="MISSING PATIENT NAME" "RTN","DGPFRAL1",136,0) . S DGPDFN=$P(DGPFA("DFN"),U) "RTN","DGPFRAL1",137,0) . S DGFGNM=$P(DGPFA("FLAG"),U,2) "RTN","DGPFRAL1",138,0) . S:DGFGNM']"" DGFGNM="MISSING FLAG NAME" "RTN","DGPFRAL1",139,0) . S DGLINE=DGPAT("SSN")_U_$E(DGFGNM,1,17)_U_$P(DGPFAH("ACTION"),U,2)_U_DGACTDT "RTN","DGPFRAL1",140,0) . S DGLNCNT=DGLNCNT+1 "RTN","DGPFRAL1",141,0) . S @DGLIST@(DGCATG,DGFGNM,DGPNM,DGPDFN,DGLNCNT)=DGLINE "RTN","DGPFRAL1",142,0) ; "RTN","DGPFRAL1",143,0) Q "RTN","DGPFRAL1",144,0) ; "RTN","DGPFRAL1",145,0) PRINT(DGSORT,DGLIST) ;output report "RTN","DGPFRAL1",146,0) ; Input: "RTN","DGPFRAL1",147,0) ; DGSORT - array of user selected report parameters "RTN","DGPFRAL1",148,0) ; DGLIST - temp global name used for report list "RTN","DGPFRAL1",149,0) ; "RTN","DGPFRAL1",150,0) ; Output: Formatted report to user selected device "RTN","DGPFRAL1",151,0) ; "RTN","DGPFRAL1",152,0) N DGCAT ;flag category "RTN","DGPFRAL1",153,0) N DGCNT ;counter of detail lines "RTN","DGPFRAL1",154,0) N DGDFN ;ien of patient "RTN","DGPFRAL1",155,0) N DGDT ;date time report printed "RTN","DGPFRAL1",156,0) N DGFG ;flag name "RTN","DGPFRAL1",157,0) N DGGRAND ;flag to print grand totals "RTN","DGPFRAL1",158,0) N DGLINE ;string of hyphens (80) for report header format "RTN","DGPFRAL1",159,0) N DGLN ;loop var "RTN","DGPFRAL1",160,0) N DGNAM ;patient name "RTN","DGPFRAL1",161,0) N DGODFN ;print loop var flag "RTN","DGPFRAL1",162,0) N DGOFG ;print loop var flag "RTN","DGPFRAL1",163,0) N DGPCAT ;print form of category "RTN","DGPFRAL1",164,0) N DGPAGE ;page counter "RTN","DGPFRAL1",165,0) N DGQ ;quit flag "RTN","DGPFRAL1",166,0) N DGSTR ;string of detail line to display "RTN","DGPFRAL1",167,0) N X,Y "RTN","DGPFRAL1",168,0) ; "RTN","DGPFRAL1",169,0) S (DGCNT,DGQ,DGPAGE,DGGRAND)=0,$P(DGLINE,"-",81)="" "RTN","DGPFRAL1",170,0) S DGDT=$P($$FMTE^XLFDT($$NOW^XLFDT,"T"),":",1,2) "RTN","DGPFRAL1",171,0) S (DGCAT,DGPCAT)=+DGSORT("DGCAT") "RTN","DGPFRAL1",172,0) ; "RTN","DGPFRAL1",173,0) I $O(@DGLIST@(""))="" D Q "RTN","DGPFRAL1",174,0) . D HEAD "RTN","DGPFRAL1",175,0) . W !!," >>> No Record Flag Assignments were found using the report criteria.",! "RTN","DGPFRAL1",176,0) ; "RTN","DGPFRAL1",177,0) ; loop and print report "RTN","DGPFRAL1",178,0) S (DGCAT,DGFG,DGNAM,DGDFN,DGODFN,DGOFG,DGLN,DGSTR)="" "RTN","DGPFRAL1",179,0) F S DGCAT=$O(@DGLIST@(DGCAT)) Q:DGCAT="" D Q:DGQ "RTN","DGPFRAL1",180,0) . D HEAD S DGCNT=0 "RTN","DGPFRAL1",181,0) . F S DGFG=$O(@DGLIST@(DGCAT,DGFG)) Q:DGFG="" D Q:DGQ "RTN","DGPFRAL1",182,0) .. F S DGNAM=$O(@DGLIST@(DGCAT,DGFG,DGNAM)) Q:DGNAM="" D Q:DGQ "RTN","DGPFRAL1",183,0) ... F S DGDFN=$O(@DGLIST@(DGCAT,DGFG,DGNAM,DGDFN)) Q:DGDFN="" D Q:DGQ "RTN","DGPFRAL1",184,0) .... F S DGLN=$O(@DGLIST@(DGCAT,DGFG,DGNAM,DGDFN,DGLN)) Q:DGLN="" D Q:DGQ "RTN","DGPFRAL1",185,0) ..... S DGSTR=$G(@DGLIST@(DGCAT,DGFG,DGNAM,DGDFN,DGLN)) "RTN","DGPFRAL1",186,0) ..... W ! "RTN","DGPFRAL1",187,0) ..... I $Y>(IOSL-4) D PAUSE(.DGQ) Q:DGQ D HEAD S DGODFN="" W ! "RTN","DGPFRAL1",188,0) ..... ; - write name and ssn once "RTN","DGPFRAL1",189,0) ..... I DGODFN'=DGDFN S DGODFN=DGDFN,DGOFG=DGFG D "RTN","DGPFRAL1",190,0) ...... W $E(DGNAM,1,18),?20,$P(DGSTR,U),?32,$E($P(DGSTR,U,2),1,17) "RTN","DGPFRAL1",191,0) ..... ; - write new flag name "RTN","DGPFRAL1",192,0) ..... I DGOFG'=DGFG S DGOFG=DGFG W ?32,$E($P(DGSTR,U,2),1,17) "RTN","DGPFRAL1",193,0) ..... ; - write action detail "RTN","DGPFRAL1",194,0) ..... W ?51,$P(DGSTR,U,3),?69,$P(DGSTR,U,4) "RTN","DGPFRAL1",195,0) ..... S DGCNT=DGCNT+1,DGCNT(DGCAT)=$G(DGCNT(DGCAT))+1 "RTN","DGPFRAL1",196,0) . Q:DGQ "RTN","DGPFRAL1",197,0) . I DGCNT D "RTN","DGPFRAL1",198,0) .. W !!,"Total Actions not Linked for Category "_$S(DGCAT=1:"I",1:"II")_": ",?46,$J(+$G(DGCNT(DGCAT)),6) "RTN","DGPFRAL1",199,0) .. S DGCNT=0,DGODFN="" "RTN","DGPFRAL1",200,0) .. D:DGPCAT=3 PAUSE(.DGQ) "RTN","DGPFRAL1",201,0) ; "RTN","DGPFRAL1",202,0) ;Shutdown if stop task requested "RTN","DGPFRAL1",203,0) I DGQ W:$D(ZTQUEUED) !!,"REPORT STOPPED AT USER REQUEST" Q "RTN","DGPFRAL1",204,0) ; "RTN","DGPFRAL1",205,0) I +DGSORT("DGCAT")=3 D ; Grand totals (B)oth Categories "RTN","DGPFRAL1",206,0) . S DGCAT=3,DGGRAND=1 "RTN","DGPFRAL1",207,0) . D HEAD "RTN","DGPFRAL1",208,0) . W !!,"REPORT SUMMARY:",!,"---------------" "RTN","DGPFRAL1",209,0) . F DGCAT=1,2,3 D "RTN","DGPFRAL1",210,0) .. S:DGCAT'=3 DGCNT(3)=$G(DGCNT(3))+$G(DGCNT(DGCAT)) "RTN","DGPFRAL1",211,0) .. W:DGCAT=3 !?48,"-------" "RTN","DGPFRAL1",212,0) .. W !,"Total Actions not Linked for Category " "RTN","DGPFRAL1",213,0) .. W $S(DGCAT=1:"I",DGCAT=2:"II",1:"I & II"),":" "RTN","DGPFRAL1",214,0) .. W ?49,$J(+$G(DGCNT(DGCAT)),6) "RTN","DGPFRAL1",215,0) ; "RTN","DGPFRAL1",216,0) W !!,"" "RTN","DGPFRAL1",217,0) Q "RTN","DGPFRAL1",218,0) ; "RTN","DGPFRAL1",219,0) PAUSE(DGQ) ; pause screen display "RTN","DGPFRAL1",220,0) ; Input: "RTN","DGPFRAL1",221,0) ; DGQ - var used to quit report processing to user CRT "RTN","DGPFRAL1",222,0) ; Output: "RTN","DGPFRAL1",223,0) ; DGQ - passed by reference - 0 = Continue, 1 = Quit "RTN","DGPFRAL1",224,0) ; "RTN","DGPFRAL1",225,0) I $G(DGPAGE)>0,$E(IOST,1,2)="C-" K DIR S DIR(0)="E" D ^DIR K DIR S:+Y=0 DGQ=1 "RTN","DGPFRAL1",226,0) Q "RTN","DGPFRAL1",227,0) ; "RTN","DGPFRAL1",228,0) HEAD ;Print/Display page header "RTN","DGPFRAL1",229,0) ; "RTN","DGPFRAL1",230,0) I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,DGQ)=1 Q "RTN","DGPFRAL1",231,0) ; "RTN","DGPFRAL1",232,0) W:'($E(IOST,1,2)'="C-"&'DGPAGE) @IOF "RTN","DGPFRAL1",233,0) ; "RTN","DGPFRAL1",234,0) S DGPAGE=$G(DGPAGE)+1 "RTN","DGPFRAL1",235,0) W !?25,"PATIENT RECORD FLAGS" "RTN","DGPFRAL1",236,0) W !?8,"ASSIGNMENT ACTION NOT LINKED TO A PROGRESS NOTE REPORT",?68,"Page: ",$G(DGPAGE) "RTN","DGPFRAL1",237,0) W !,"Report Selected: "_$S($G(DGPCAT)=1:"Category I (National)",$G(DGPCAT)=2:"Category II (Local)",1:"Both (Category I & II)") "RTN","DGPFRAL1",238,0) W !?5,"DATE RANGE: ",$$FDATE^VALM1($G(DGSORT("DGBEG")))_" TO "_$$FDATE^VALM1($G(DGSORT("DGEND"))) "RTN","DGPFRAL1",239,0) W ?50,"Printed: ",DGDT "RTN","DGPFRAL1",240,0) W !,DGLINE "RTN","DGPFRAL1",241,0) ; "RTN","DGPFRAL1",242,0) Q:DGGRAND "RTN","DGPFRAL1",243,0) ; "RTN","DGPFRAL1",244,0) W !!,"CATEGORY: "_$S($G(DGCAT)=1:"Category I (National)",$G(DGCAT)=2:"Category II (Local)",1:"Both (Category I & II)") "RTN","DGPFRAL1",245,0) W !!,"PATIENT",?20,"SSN",?32,"FLAG NAME",?51,"ACTION",?69,"ACTION DATE" "RTN","DGPFRAL1",246,0) W !,"------------------",?20,"----------",?32,"-----------------",?51,"----------------",?69,"-----------" "RTN","DGPFRAL1",247,0) Q "RTN","DGPFRAL1",248,0) ; "RTN","DGPFRAL1",249,0) EXIT ; "RTN","DGPFRAL1",250,0) I $D(ZTQUEUED) S ZTREQ="@" "RTN","DGPFRAL1",251,0) I '$D(ZTQUEUED) D "RTN","DGPFRAL1",252,0) . K %ZIS,POP "RTN","DGPFRAL1",253,0) . D ^%ZISC,HOME^%ZIS "RTN","DGPFRAL1",254,0) Q "RTN","DGPFRAL1",255,0) ; "RTN","DGPFRAL1",256,0) ENTINERR(DGIEN) ;is last action ENTERED IN ERROR "RTN","DGPFRAL1",257,0) ; Input: "RTN","DGPFRAL1",258,0) ; DGIEN - (required) Pointer to PRF ASSIGNMENT (#26.13) file "RTN","DGPFRAL1",259,0) ; "RTN","DGPFRAL1",260,0) ; Output: "RTN","DGPFRAL1",261,0) ; Function Value - Return 1 on success, 0 on failure "RTN","DGPFRAL1",262,0) ; "RTN","DGPFRAL1",263,0) N DGPFAH "RTN","DGPFRAL1",264,0) ; "RTN","DGPFRAL1",265,0) I $$GETHIST^DGPFAAH($$GETLAST^DGPFAAH(DGIEN),.DGPFAH) "RTN","DGPFRAL1",266,0) Q +$G(DGPFAH("ACTION"))=5 "RTN","DGPFRAL1",267,0) ; "RTN","DGPFRAL1",268,0) FLGXFER ;If flag transferred and prior to assignment chg dt, do not rpt missing TIU link "RTN","DGPFRAL1",269,0) N DGHIEN,DGHACT "RTN","DGPFRAL1",270,0) Q:$P($G(DGPFA("ORIGSITE")),U)=$P($G(DGPFA("OWNER")),U) "RTN","DGPFRAL1",271,0) S DGHIEN="" "RTN","DGPFRAL1",272,0) F S DGHIEN=$O(DGHIENS(DGHIEN)) Q:DGHIEN="" D "RTN","DGPFRAL1",273,0) . S DGHACT=DGHIENS(DGHIEN) "RTN","DGPFRAL1",274,0) . I $G(^DGPF(26.14,DGHACT,1,1,0))["Change of flag assignment ownership." S DGFLAG=$P(DGHIEN,U) "RTN","DGPFRAL1",275,0) Q "RTN","DGPFRAL1",276,0) ; "RTN","DGREGTZL") 0^3^B51269802^B49877397 "RTN","DGREGTZL",1,0) DGREGTZL ;ALB/BDB - Temporary & Confidential Address Edits API ; 11/30/11 10:00am "RTN","DGREGTZL",2,0) ;;5.3;Registration;**851,892**;Aug 13, 1993;Build 9 "RTN","DGREGTZL",3,0) EN(RESULT,DFN) ;Let user edit zip+4, city, state, county based on zip-linking "RTN","DGREGTZL",4,0) ; Output: RESULT(field#) = User Input External ^ Internal "RTN","DGREGTZL",5,0) K RESULT "RTN","DGREGTZL",6,0) N DGIND,DGTOT "RTN","DGREGTZL",7,0) I $G(DFN)="" S RESULT=-1 Q "RTN","DGREGTZL",8,0) N DGR,DGDFLT,DGALW,DGZIP,DGN "RTN","DGREGTZL",9,0) S DGN="" "RTN","DGREGTZL",10,0) I $$FOREIGN() D Q "RTN","DGREGTZL",11,0) . D FRGNEDT(.DGR,DFN) "RTN","DGREGTZL",12,0) . I $G(DGR)=-1 S RESULT=-1 Q "RTN","DGREGTZL",13,0) . F DGN=FZIP,FCITY,FSTATE,FCOUNTY S RESULT(DGN)=$G(DGR(DGN)) "RTN","DGREGTZL",14,0) S DGZIP=$$ZIP(DFN) "RTN","DGREGTZL",15,0) I DGZIP=-1 S RESULT=-1 Q "RTN","DGREGTZL",16,0) S RESULT(FZIP)=DGZIP "RTN","DGREGTZL",17,0) S DGIND=$$CITY(.DGR,DGZIP,DFN) "RTN","DGREGTZL",18,0) I DGIND=$G(DGTOT)+1 S DGIND="" "RTN","DGREGTZL",19,0) I $G(DGR)=-1 S RESULT=-1 Q "RTN","DGREGTZL",20,0) S RESULT(FCITY)=$G(DGR) "RTN","DGREGTZL",21,0) ;S DGALW=$$ALWEDT^DGREGDD1($G(DUZ),DGZIP "RTN","DGREGTZL",22,0) S DGALW=$$ALWEDTTC($G(DUZ),DGZIP) "RTN","DGREGTZL",23,0) I DGALW=1 D "RTN","DGREGTZL",24,0) . K DGR D STCNTY(.DGR,DGZIP,DFN,DGIND) "RTN","DGREGTZL",25,0) . I $G(DGR)=-1 S RESULT=-1 Q "RTN","DGREGTZL",26,0) . S RESULT(FSTATE)=$G(DGR(FSTATE)) "RTN","DGREGTZL",27,0) . S RESULT(FCOUNTY)=$G(DGR(FCOUNTY)) "RTN","DGREGTZL",28,0) I DGALW=0 D "RTN","DGREGTZL",29,0) . I DGZIP'="" D LINK(.DGDFLT,DGZIP,1) "RTN","DGREGTZL",30,0) . S RESULT(FSTATE)=$G(DGDFLT(FSTATE)) "RTN","DGREGTZL",31,0) . S RESULT(FCOUNTY)=$G(DGDFLT(FCOUNTY)) "RTN","DGREGTZL",32,0) Q "RTN","DGREGTZL",33,0) ZIP(DFN) ;Let user input zip+4 "RTN","DGREGTZL",34,0) ZAGN N DIR,DTOUT,DUOUT,DIROUT,DGDATA "RTN","DGREGTZL",35,0) S DIR(0)="2,"_FZIP "RTN","DGREGTZL",36,0) S DA=DFN "RTN","DGREGTZL",37,0) D ^DIR "RTN","DGREGTZL",38,0) I $D(DTOUT) Q -1 "RTN","DGREGTZL",39,0) I $D(DUOUT)!$D(DIROUT) D UPCT^DGREGTED G ZAGN "RTN","DGREGTZL",40,0) S DGZIP=$G(Y) "RTN","DGREGTZL",41,0) ;allow bogus zip: "RTN","DGREGTZL",42,0) I $D(^XUSEC("EAS GMT COUNTY EDIT",+DUZ)) Q DGZIP "RTN","DGREGTZL",43,0) I DGZIP="" Q DGZIP "RTN","DGREGTZL",44,0) D POSTALB^XIPUTIL(DGZIP,.DGDATA) "RTN","DGREGTZL",45,0) ;DG*730 - later commented out by DG*760 "RTN","DGREGTZL",46,0) ;I $G(DGDATA(1,"CITY ABBREVIATION"))'="",$G(DGDATA(1,"CITY ABBREVIATION"))=$G(DGDATA(2,"CITY")) S DGDATA=1 K DGDATA(2) "RTN","DGREGTZL",47,0) I $D(DGDATA("ERROR")) D G ZAGN "RTN","DGREGTZL",48,0) . W $C(7)," ??" "RTN","DGREGTZL",49,0) Q DGZIP "RTN","DGREGTZL",50,0) CITY(RESULT,ZIP,DFN) ;Base on zip, let user input city(#FCITY) "RTN","DGREGTZL",51,0) ; Input: "RTN","DGREGTZL",52,0) ; ZIP - user input zip for the patient primary address "RTN","DGREGTZL",53,0) ; DFN - Interal entry number of Patient File (#2) "RTN","DGREGTZL",54,0) ; Output:RESULT=-1 (input error or timed or ^ out) "RTN","DGREGTZL",55,0) ; or =user input city "RTN","DGREGTZL",56,0) ; Array index # of selected city. "RTN","DGREGTZL",57,0) K RESULT "RTN","DGREGTZL",58,0) N DGDATA,DIR,DA,Y,DTOUT,DUOUT,DIROUT,DGIND "RTN","DGREGTZL",59,0) N DGCITY,DGST,DGCNTY,DGABRV,DGN,DGECH,DGSOC "RTN","DGREGTZL",60,0) N DOLDCITY,DGSAME,DGELEVEN "RTN","DGREGTZL",61,0) N DGCITI "RTN","DGREGTZL",62,0) S DGIND="" "RTN","DGREGTZL",63,0) D POSTALB^XIPUTIL(ZIP,.DGDATA) "RTN","DGREGTZL",64,0) D FIELD^DID(2,FCITY,"N","LABEL","DGCITY") "RTN","DGREGTZL",65,0) S DGN="" "RTN","DGREGTZL",66,0) I '$D(DGDATA("ERROR")) D "RTN","DGREGTZL",67,0) . S DOLDCITY=$$GET1^DIQ(2,DFN_",",FCITY) "RTN","DGREGTZL",68,0) . S DGSAME=0 "RTN","DGREGTZL",69,0) . F S DGN=$O(DGDATA(DGN)) Q:DGN="" D "RTN","DGREGTZL",70,0) .. S DGCITI=$P($G(DGDATA(DGN,"CITY")),"*",1) "RTN","DGREGTZL",71,0) .. S DGABRV=$G(DGDATA(DGN,"CITY ABBREVIATION")) "RTN","DGREGTZL",72,0) .. I DOLDCITY'="",DGCITI=DOLDCITY!(DGABRV=DOLDCITY) S DGSAME=1 "RTN","DGREGTZL",73,0) .. I $G(DGDATA(DGN,"CITY"))["*" S DGCITI=DGCITI_"*" "RTN","DGREGTZL",74,0) .. S DGECH=DGN_":"_DGCITI "RTN","DGREGTZL",75,0) .. S DGSOC=$S($G(DGSOC)="":DGECH,1:DGSOC_";"_DGECH) "RTN","DGREGTZL",76,0) .. S DGTOT=DGN "RTN","DGREGTZL",77,0) .I 'DGSAME S DGELEVEN=$G(^DPT(DFN,.11)) D "RTN","DGREGTZL",78,0) ..Q:$P(DGELEVEN,U,6)'=$G(DGDATA(DGTOT,"POSTAL CODE")) "RTN","DGREGTZL",79,0) ..Q:$P(DGELEVEN,U,14)'="VAMC" "RTN","DGREGTZL",80,0) ..Q:$P(DGELEVEN,U,15)'=$$GETSITE^DGMTU4($G(DUZ)) "RTN","DGREGTZL",81,0) ..Q:$P(DGELEVEN,U,17)'>.5 "RTN","DGREGTZL",82,0) ..S DGN=DGTOT+1,DGECH=DGN_":"_DOLDCITY,DGSOC=DGSOC_";"_DGECH "RTN","DGREGTZL",83,0) .; "RTN","DGREGTZL",84,0) . I $D(^XUSEC("EAS GMT COUNTY EDIT",+DUZ)) D "RTN","DGREGTZL",85,0) .. S DGSOC=$G(DGSOC)_";"_99_":"_"FREE TEXT" "RTN","DGREGTZL",86,0) . S DIR(0)="SO^"_$G(DGSOC) "RTN","DGREGTZL",87,0) . S DIR("B")=$$GET1^DIQ(2,DFN_",",FCITY) "RTN","DGREGTZL",88,0) . S DIR("A")=$G(DGCITY("LABEL")) "RTN","DGREGTZL",89,0) CAGN1 . D ^DIR "RTN","DGREGTZL",90,0) . I $D(DTOUT) S RESULT=-1 Q "RTN","DGREGTZL",91,0) . I $D(DUOUT)!$D(DIROUT) D UPCT^DGREGTED G CAGN1 "RTN","DGREGTZL",92,0) . S RESULT=$P($G(Y(0)),"*") "RTN","DGREGTZL",93,0) . S DGIND=$G(Y) "RTN","DGREGTZL",94,0) I ($G(Y)=99)!($D(DGDATA("ERROR"))) D "RTN","DGREGTZL",95,0) CAGN2 . I '$D(^XUSEC("EAS GMT COUNTY EDIT",+DUZ)) Q "RTN","DGREGTZL",96,0) . N DIR,X,Y "RTN","DGREGTZL",97,0) . S DIR(0)="2,"_FCITY "RTN","DGREGTZL",98,0) . S DA=DFN "RTN","DGREGTZL",99,0) . D ^DIR "RTN","DGREGTZL",100,0) . I $D(DTOUT) S RESULT=-1 Q "RTN","DGREGTZL",101,0) . I $D(DUOUT)!$D(DIROUT) D UPCT^DGREGTED G CAGN2 "RTN","DGREGTZL",102,0) . S RESULT=$G(Y) "RTN","DGREGTZL",103,0) I $L($G(RESULT))>15 D "RTN","DGREGTZL",104,0) . ;S DGN=Y "RTN","DGREGTZL",105,0) . S DGN=$G(Y) "RTN","DGREGTZL",106,0) . I 'DGN S RESULT=$E(RESULT,1,15) "RTN","DGREGTZL",107,0) . E S RESULT=$G(DGDATA(DGN,"CITY ABBREVIATION")) "RTN","DGREGTZL",108,0) . ;S RESULT=$G(DGDATA(DGN,"CITY ABBREVIATION")) "RTN","DGREGTZL",109,0) Q DGIND "RTN","DGREGTZL",110,0) ; "RTN","DGREGTZL",111,0) LINK(RESULT,ZIP,DGN) ;From zip, get the linked state,county "RTN","DGREGTZL",112,0) K RESULT "RTN","DGREGTZL",113,0) N DGDATA,CNTYIEN "RTN","DGREGTZL",114,0) S CNTYIEN="" "RTN","DGREGTZL",115,0) S DGN=$G(DGN) "RTN","DGREGTZL",116,0) I (DGN="")&($$MLT^DGREGDD1(ZIP)) S DGN=1 "RTN","DGREGTZL",117,0) I (DGN=99)&($$MLT^DGREGDD1(ZIP)) S DGN=1 "RTN","DGREGTZL",118,0) I (DGN="")!(DGN=99) Q "RTN","DGREGTZL",119,0) D POSTALB^XIPUTIL(ZIP,.DGDATA) "RTN","DGREGTZL",120,0) S:$G(DGDATA(DGN,"STATE POINTER"))'="" CNTYIEN=$$FIND1^DIC(5.01,","_$G(DGDATA(DGN,"STATE POINTER"))_",","MOXQ",$E($G(DGDATA(DGN,"FIPS CODE")),3,5),"C") "RTN","DGREGTZL",121,0) D:'CNTYIEN ;could be duplicate county codes in subfile #5.01 "RTN","DGREGTZL",122,0) .Q:'$D(^DIC(5,+$G(DGDATA(DGN,"STATE POINTER")),1)) "RTN","DGREGTZL",123,0) .Q:$E($G(DGDATA(DGN,"FIPS CODE")),3,5)="" "RTN","DGREGTZL",124,0) .S CNTYIEN=$O(^DIC(5,$G(DGDATA(DGN,"STATE POINTER")),1,"C",$E($G(DGDATA(DGN,"FIPS CODE")),3,5),"")) "RTN","DGREGTZL",125,0) S RESULT(FSTATE)=$G(DGDATA(DGN,"STATE"))_U_$G(DGDATA(DGN,"STATE POINTER")) "RTN","DGREGTZL",126,0) S RESULT(FCOUNTY)=$G(DGDATA(DGN,"COUNTY"))_U_$G(CNTYIEN)_U_$E($G(DGDATA(DGN,"FIPS CODE")),3,5) "RTN","DGREGTZL",127,0) Q "RTN","DGREGTZL",128,0) ; "RTN","DGREGTZL",129,0) STCNTY(RESULT,ZIP,DFN,DGNUM) ;Based on zip,input state (#FSTATE) and county (#FCOUNTY) "RTN","DGREGTZL",130,0) K RESULT "RTN","DGREGTZL",131,0) S DGNUM=$G(DGNUM) "RTN","DGREGTZL",132,0) N DGN,DGDFLT,DGST,POP,DIR,X,Y,DTOUT,DUOUT,DIROUT "RTN","DGREGTZL",133,0) S POP=0 "RTN","DGREGTZL",134,0) D LINK(.DGDFLT,ZIP,DGNUM) "RTN","DGREGTZL",135,0) F DGN=FSTATE,FCOUNTY Q:POP D "RTN","DGREGTZL",136,0) SCAGN . I DGN=FSTATE S DIR(0)=2_","_DGN "RTN","DGREGTZL",137,0) . I ($G(DGST)="")&(DGN=FCOUNTY) Q "RTN","DGREGTZL",138,0) . I DGN=FCOUNTY S DIR(0)="POA^DIC(5,DGST,1,:AEMQ" "RTN","DGREGTZL",139,0) . S DIR("B")=$P($G(DGDFLT(DGN)),U) "RTN","DGREGTZL",140,0) . D ^DIR "RTN","DGREGTZL",141,0) . I $D(DTOUT) S POP=1 Q "RTN","DGREGTZL",142,0) . I $D(DUOUT)!$D(DIROUT) D UPCT^DGREGAED G SCAGN "RTN","DGREGTZL",143,0) . S RESULT(DGN)=$P($G(Y),U,2)_U_$P($G(Y),U) "RTN","DGREGTZL",144,0) . I DGN=FSTATE S DGST=$P($G(Y),U) "RTN","DGREGTZL",145,0) . I DGN=FCOUNTY S RESULT(FCOUNTY)=$$CNTY(DGST,$P($G(RESULT(FCOUNTY)),U,2)) "RTN","DGREGTZL",146,0) I POP=1 S RESULT=-1 "RTN","DGREGTZL",147,0) Q "RTN","DGREGTZL",148,0) CNTY(DGST,DGCIEN) ;Return county name and code "RTN","DGREGTZL",149,0) ;Input:state number and county IEN "RTN","DGREGTZL",150,0) ;Output: CountyName^CountyIEN^CountyCode "RTN","DGREGTZL",151,0) I ($G(DGST)="")!($G(DGCIEN)="") S RESULT=-1 Q RESULT "RTN","DGREGTZL",152,0) N DGR,RESULT "RTN","DGREGTZL",153,0) S DGR=$G(^DIC(5,DGST,1,DGCIEN,0)) "RTN","DGREGTZL",154,0) S RESULT=$P($G(DGR),U)_U_DGCIEN_U_$P($G(DGR),U,3) "RTN","DGREGTZL",155,0) Q RESULT "RTN","DGREGTZL",156,0) FOREIGN() ;Manila (Philippines) doesn't need zip linking. "RTN","DGREGTZL",157,0) ;Output: 1 - area need no zip linking "RTN","DGREGTZL",158,0) ; 0 - zip-linking area "RTN","DGREGTZL",159,0) I $$STA^XUAF4(+$$KSP^XUPARAM("INST"))=358 Q 1 "RTN","DGREGTZL",160,0) ;;;I $$STA^XUAF4(+$$KSP^XUPARAM("INST"))=500 Q 1 ;;HERE TEST "RTN","DGREGTZL",161,0) Q 0 "RTN","DGREGTZL",162,0) FRGNEDT(DGINPUT,DFN) ;Edit zip+4, city, state, county for no zip-linking area "RTN","DGREGTZL",163,0) K DGINPUT "RTN","DGREGTZL",164,0) N DGN,DIR,DTOUT,DUOUT,DIROUT,X,Y,POP,DGST "RTN","DGREGTZL",165,0) S POP=0 "RTN","DGREGTZL",166,0) F DGN=FZIP,FCITY,FSTATE,FCOUNTY Q:POP D "RTN","DGREGTZL",167,0) FAGN . I ($G(DGST)="")&(DGN=FCOUNTY) Q "RTN","DGREGTZL",168,0) . S DIR(0)=2_","_DGN "RTN","DGREGTZL",169,0) . I DGN=FCOUNTY D "RTN","DGREGTZL",170,0) .. S DIR(0)="POA^DIC(5,DGST,1,:AEMQ" "RTN","DGREGTZL",171,0) .. S DIR("B")=$$GET1^DIQ(2,DFN_",",FCOUNTY) "RTN","DGREGTZL",172,0) . I DGN'=FCOUNTY S DA=DFN "RTN","DGREGTZL",173,0) . D ^DIR "RTN","DGREGTZL",174,0) . I $D(DTOUT) S POP=1 Q "RTN","DGREGTZL",175,0) . I $D(DUOUT)!$D(DIROUT) D UPCT^DGREGAED G FAGN "RTN","DGREGTZL",176,0) . I (DGN=FCITY)!(DGN=FZIP) S DGINPUT(DGN)=$G(Y) "RTN","DGREGTZL",177,0) . I (DGN=FSTATE) D "RTN","DGREGTZL",178,0) .. S DGST=$P($G(Y),U) "RTN","DGREGTZL",179,0) .. I DGST=$$GET1^DIQ(2,DFN_",",FSTATE,"I") D "RTN","DGREGTZL",180,0) ... S DGINPUT(FSTATE)=$$GET1^DIQ(2,DFN_",",FSTATE)_U_DGST "RTN","DGREGTZL",181,0) .. I DGST'=$$GET1^DIQ(2,DFN_",",FSTATE,"I") D "RTN","DGREGTZL",182,0) ... S DGINPUT(FSTATE)=$P($G(Y(0)),U)_U_DGST "RTN","DGREGTZL",183,0) . I DGN=FCOUNTY S DGINPUT(DGN)=$P($G(Y),U,2)_U_$P($G(Y),U) "RTN","DGREGTZL",184,0) I POP=1 S RESULT=-1 "RTN","DGREGTZL",185,0) Q "RTN","DGREGTZL",186,0) ; "RTN","DGREGTZL",187,0) ALWEDTTC(DUZ,ZIP) ; determine if a security key is necessary for editing "RTN","DGREGTZL",188,0) ; Input: zip code "RTN","DGREGTZL",189,0) ; Output: 1: allow edit state and county "RTN","DGREGTZL",190,0) ; 0: don't allow edit state and county "RTN","DGREGTZL",191,0) N EASDATA "RTN","DGREGTZL",192,0) I $G(ZIP)="" Q 0 "RTN","DGREGTZL",193,0) I '$D(DUZ) Q 0 "RTN","DGREGTZL",194,0) I '$$MLT^DGREGDD1(ZIP) Q 1 ; > 1 state or county for the zip - allow edit "RTN","DGREGTZL",195,0) I $$FOREIGN^DGREGAZL() Q 1 ; Foreign location - allow edit "RTN","DGREGTZL",196,0) D POSTAL^XIPUTIL(ZIP,.EASDATA) "RTN","DGREGTZL",197,0) Q:$D(EASDATA("ERROR")) 1 ;zip code does not exist - allow editing "RTN","DGREGTZL",198,0) Q:'$D(EASDATA("FIPS CODE")) 1 ;cnty code does not exist - allow edit "RTN","DGREGTZL",199,0) Q:'$D(EASDATA("STATE")) 1 ;state does not exist - allow editing "RTN","DGREGTZL",200,0) Q:$D(^XUSEC("EAS GMT COUNTY EDIT",+DUZ)) 1 ;user holds security key "RTN","DGREGTZL",201,0) W !,$S(TYPE="TEMP":"TEMPORARY ",TYPE="CONF":"CONFIDENTIAL ",1:"")_"STATE: ",$G(EASDATA("STATE")) "RTN","DGREGTZL",202,0) W !,$S(TYPE="TEMP":"TEMPORARY ",TYPE="CONF":"CONFIDENTIAL ",1:"")_"COUNTY: ",$G(EASDATA("COUNTY")) "RTN","DGREGTZL",203,0) Q 0 "VER") 8.0^22.0 "BLD",9731,6) ^793 **END** **END**