[613] | 1 | DG17201 ;BHM/RGY,ALS-Find and save all files pointing to religion and marital status files ;FEB 20,1998
|
---|
| 2 | ;;5.3;Registration;**172**;Aug 13, 1993
|
---|
| 3 | CF ;
|
---|
| 4 | NEW FILE,FIELD,CONV
|
---|
| 5 | K ^TMP("DG11N13",$J)
|
---|
| 6 | F CONV=11,13 F FILE=0:0 S FILE=$O(^DD(CONV,0,"PT",FILE)) Q:FILE="" F FIELD=0:0 S FIELD=$O(^DD(CONV,0,"PT",FILE,FIELD)) Q:FIELD="" D ADD(FILE,FIELD,CONV)
|
---|
| 7 | D:$D(^TMP("DG11N13",$J)) CONVMSG
|
---|
| 8 | K ^TMP("DG11N13",$J)
|
---|
| 9 | Q
|
---|
| 10 | ADD(FILE,FIELD,TYPE) ;
|
---|
| 11 | NEW PIECE,NODE,GLOB,GLLOC
|
---|
| 12 | I FILE=""!(FIELD="") Q
|
---|
| 13 | I FILE=390.2 Q
|
---|
| 14 | D FIELD^DID(FILE,FIELD,"","GLOBAL SUBSCRIPT LOCATION","GLLOC")
|
---|
| 15 | S PIECE=$P($G(GLLOC("GLOBAL SUBSCRIPT LOCATION")),";",2)
|
---|
| 16 | I PIECE="" D CONVF(FILE,FIELD,"Unknown/Invalid pointer, DD("_CONV_",0,""PT"","_FILE_","_FIELD_").") Q
|
---|
| 17 | S NODE=$P($G(GLLOC("GLOBAL SUBSCRIPT LOCATION")),";")
|
---|
| 18 | I NODE="" D CONVF(FILE,FIELD,"Unknown/Invalid pointer, DD("_CONV_",0,""PT"","_FILE_","_FIELD_").") Q
|
---|
| 19 | S GLOB=$P($$GET1^DID(FILE,"","","GLOBAL NAME"),U,2) I GLOB="" D NOCONV(FILE,FIELD) Q
|
---|
| 20 | S EN=$$ADD^DG17202(390.1)
|
---|
| 21 | S DIE="^XTMP(""DGTMP"",390.1,",DR="[DG172 NEW ENTRY]",DA=EN D ^DIE
|
---|
| 22 | K DIE,DR,DA,EN,X
|
---|
| 23 | K ^TMP("DIERR",$J)
|
---|
| 24 | Q
|
---|
| 25 | NOCONV(FILE,FIELD) ;CONVERTING FILE 11 AND 13 NON-STANDARD ENTRIES
|
---|
| 26 | N SUBX,SUB,PIECE,GLLOC,SUBFILE
|
---|
| 27 | S SUB(0)=FILE_"^"_FIELD
|
---|
| 28 | I '$D(^DD(FILE,0,"UP")) D CONVF(FILE,FIELD,"Unknown/Invalid pointer, DD("_CONV_",0,""PT"","_FILE_","_FIELD_").") Q
|
---|
| 29 | I $D(^DD(FILE,0,"UP")) S SUB=1,SUBFILE=FILE F S:$D(^DD(SUBFILE,0,"UP")) SUB(SUB)=^DD(SUBFILE,0,"UP"),SUBFILE=SUB(SUB),SUB=SUB+1 Q:'$D(^DD(SUBFILE,0,"UP"))
|
---|
| 30 | S SUBX=$O(SUB(" "),-1) I SUBX>0 D CONVF(FILE,FIELD,"Cannot convert the "_$P(^DD(FILE,0),U)_" in the "_$$GET1^DID(SUB(SUBX),"","","NAME")_" File.",.SUB)
|
---|
| 31 | Q
|
---|
| 32 | CONVF(FILE,FIELD,TXT,SUB) ;
|
---|
| 33 | N X,LAST
|
---|
| 34 | S ^TMP("DG11N13",$J,CONV,$O(^TMP("DG11N13",$J,CONV," "),-1)+1)=FILE_"^"_FIELD_"^"_TXT_"^"
|
---|
| 35 | S LAST=$O(^TMP("DG11N13",$J,CONV," "),-1)
|
---|
| 36 | I '$D(SUB) S ^TMP("DG11N13",$J,CONV,LAST)=^TMP("DG11N13",$J,CONV,LAST)_FILE
|
---|
| 37 | I $D(SUB) S X=0,LAST=$O(^TMP("DG11N13",$J,CONV," "),-1) F X=$O(SUB(" "),-1):-1:0 S ^TMP("DG11N13",$J,CONV,LAST)=^TMP("DG11N13",$J,CONV,LAST)_$P(SUB(X),U)_"/"
|
---|
| 38 | Q
|
---|
| 39 | CONVMSG ;send file 11 and 13 conversion problem message
|
---|
| 40 | N HDR,DGX,SPACE,DGY,STRG,CONV
|
---|
| 41 | S SPACE=""
|
---|
| 42 | S DGY=1
|
---|
| 43 | S STRG=" File 11 and 13 Conversion Problem list" D STRING(STRG,.DGY)
|
---|
| 44 | S STRG=" " F X=1:1:2 D STRING(STRG,.DGY)
|
---|
| 45 | F CONV=11,13 D
|
---|
| 46 | .S STRG=$S(CONV=11:"MARITAL STATUS (#11) File Conversion Problems:",CONV=13:"RELIGION (#13) File Converion Problems:",1:"") D STRING(STRG,.DGY)
|
---|
| 47 | .S STRG=" " F X=1:1:2 D STRING(STRG,.DGY)
|
---|
| 48 | .I '$D(^TMP("DG11N13",$J,CONV)) S STRG="No problems" D STRING(STRG,.DGY) Q
|
---|
| 49 | .D CONVHDR
|
---|
| 50 | .S DGX=0 F S DGX=$O(^TMP("DG11N13",$J,CONV,DGX)) Q:'DGX D
|
---|
| 51 | ..S STRG="",SPACE=""
|
---|
| 52 | ..F X=1:1 S STRG=$S(X>1:SPACE,1:"")_$P($P(^TMP("DG11N13",$J,CONV,DGX),U,4),"/",X) Q:X=$L($P(^TMP("DG11N13",$J,CONV,DGX),U,4),"/") D
|
---|
| 53 | ...I X<$L($P(^TMP("DG11N13",$J,CONV,DGX),U,4),"/") D STRING(STRG,.DGY)
|
---|
| 54 | ...S SPACE=SPACE_" "
|
---|
| 55 | ..S SPACE="",STRG=STRG_"^"_$P(^TMP("DG11N13",$J,CONV,DGX),U,2)_"^"_$P(^TMP("DG11N13",$J,CONV,DGX),U,3) D STRING(STRG,.DGY)
|
---|
| 56 | .S STRG=" " F X=1:1:2 D STRING(STRG,.DGY)
|
---|
| 57 | D MAILMSG
|
---|
| 58 | Q
|
---|
| 59 | CONVHDR ;
|
---|
| 60 | S STRG="Pointer File/Subfile^Field^Problem Description" D STRING(STRG,.DGY)
|
---|
| 61 | S STRG="-------------------------------------------------------------------" D STRING(STRG,.DGY)
|
---|
| 62 | Q
|
---|
| 63 | STRING(STR,DGY) ;convert string into column display
|
---|
| 64 | N RST ;result
|
---|
| 65 | N X
|
---|
| 66 | S RST=$P(STR,U)
|
---|
| 67 | I $P($G(STR),U,2)="" S DGY(DGY)=RST,DGY=DGY+1 Q
|
---|
| 68 | F X=$L(RST):1:25 S RST=RST_" "
|
---|
| 69 | ;format field start column at 25
|
---|
| 70 | S RST=RST_$P(STR,U,2)
|
---|
| 71 | I $P($G(STR),U,3)="" S DGY(DGY)=RST,DGY=DGY+1 Q
|
---|
| 72 | F X=$L(RST):1:35 S RST=RST_" "
|
---|
| 73 | ;format problem description start each line at 35
|
---|
| 74 | F Q:($L(RST)+$L($P(STR,U,3)))<78 D
|
---|
| 75 | .S RST=RST_$P(STR,U,3)
|
---|
| 76 | .S STR="",$P(STR,U,3)=$E(RST,79,120)
|
---|
| 77 | .S RST=$E(RST,1,78) S DGY(DGY)=RST,DGY=DGY+1
|
---|
| 78 | .S RST="" F X=1:1:35 S RST=RST_" "
|
---|
| 79 | .S RST=RST_$P(STR,U,3),$P(STR,U,3)=""
|
---|
| 80 | S DGY(DGY)=RST,DGY=DGY+1
|
---|
| 81 | Q
|
---|
| 82 | MAILMSG ;send problem message to user that started task
|
---|
| 83 | S XMDUZ="DG*5.3*172",XMTEXT="DGY(",XMY(DUZ)="",XMSUB="File 11 and 13 Conversion Problems"
|
---|
| 84 | N DIFROM D ^XMD K XMTEXT,XMY,XMSUB,XMDUZ,XMZ
|
---|
| 85 | Q
|
---|