[613] | 1 | GECSXBLD ;WISC/RFJ-map data into template map ;01 Nov 93
|
---|
| 2 | ;;2.0;GCS;;MAR 14, 1995
|
---|
| 3 | Q
|
---|
| 4 | ;
|
---|
| 5 | ;
|
---|
| 6 | MAPDATA(GECSDA) ; map data to template
|
---|
| 7 | ; return 1 if code sheet is built, 0 if not built
|
---|
| 8 | N %,%H,%I,CODESHET,DA,DA1,DATA,DELIMITR,FIELD,GECSDATE,GECSEND,GECSFLAG,GECSLINE,GECSMAP,GECSNOD1,GECSNOD2,GECSOT,GECSTNM,I,N,PIECE,SUB1,SUB2,X,Y
|
---|
| 9 | ;
|
---|
| 10 | ; keypunched code sheet
|
---|
| 11 | K CODESHET
|
---|
| 12 | I $P($G(^GECS(2100,GECSDA,0)),"^",11)="[GECS KEYPUNCH]" D Q GECSFLAG
|
---|
| 13 | . S %=0 F I=0:1 S %=$O(^GECS(2100,GECSDA,"KEY",%)) Q:%="" S CODESHET(I)=^(%,0)
|
---|
| 14 | . I I=0 W !,"NOTHING TO KEYPUNCH." D KILLCS^GECSPUR1(GECSDA) W " << CODE SHEET DELETED >>" S GECSFLAG=0 Q
|
---|
| 15 | . S %=$$SHEET,GECSFLAG=1
|
---|
| 16 | ;
|
---|
| 17 | ; fill in fields code sheet
|
---|
| 18 | ; set gecsot variable to execute output transform
|
---|
| 19 | S GECSOT=""
|
---|
| 20 | ; move code sheet field data into variable data
|
---|
| 21 | K DATA
|
---|
| 22 | S SUB1="" F S SUB1=$O(^GECS(2100,GECSDA,SUB1)) Q:SUB1="" I SUB1'="CODE" S:$D(^(SUB1))'["0" DATA(SUB1)=^(SUB1) I $D(^GECS(2100,GECSDA,SUB1,0)) D
|
---|
| 23 | . S DA1=0 F S DA1=$O(^GECS(2100,GECSDA,SUB1,DA1)) Q:'DA1 D
|
---|
| 24 | . . S SUB2="" F S SUB2=$O(^GECS(2100,GECSDA,SUB1,DA1,SUB2)) Q:SUB2="" S:$D(^GECS(2100,GECSDA,SUB1,DA1,SUB2)) DATA(SUB1,DA1,SUB2)=^(SUB2)
|
---|
| 25 | ;
|
---|
| 26 | ; get template map
|
---|
| 27 | S GECSTNM=$P(DATA(0),"^",11),GECSTNM=$E(GECSTNM,2,$L(GECSTNM)-1) I GECSTNM="" W !,"CODE SHEET ",$P(DATA(0),"^")," DOES NOT HAVE A TEMPLATE MAP DEFINED." Q 0
|
---|
| 28 | S %=$O(^DIE("B",GECSTNM,0)) I '% W !,"INPUT TEMPLATE ",GECSTNM," NOT FOUND." Q 0
|
---|
| 29 | D GETMAP^GECSXMAP(%) I '$D(GECSMAP) Q 0
|
---|
| 30 | ;
|
---|
| 31 | S GECSEND=80,DELIMITR=""
|
---|
| 32 | ; put code sheet specific code here!!!
|
---|
| 33 | I $P(DATA(0),"^",2)="VOL" S GECSEND=81
|
---|
| 34 | I $P(DATA(0),"^",2)="FMS" S DELIMITR="^",GECSEND=240
|
---|
| 35 | I $P(DATA(0),"^",2)="FEN" S DELIMITR=".",GECSEND=240
|
---|
| 36 | ; end of code sheet specific code
|
---|
| 37 | ;
|
---|
| 38 | ; build code sheet with data
|
---|
| 39 | ; set da for output transform
|
---|
| 40 | S DA=GECSDA
|
---|
| 41 | K GECSFLAG
|
---|
| 42 | S (GECSLINE,GECSNOD1)=0 F S GECSNOD1=$O(GECSMAP(GECSNOD1)) Q:'GECSNOD1 D
|
---|
| 43 | . ; single field (not multiple)
|
---|
| 44 | . I GECSMAP(GECSNOD1)'["," D Q
|
---|
| 45 | . . F PIECE=1:1 S FIELD=$P(GECSMAP(GECSNOD1),"\",PIECE) Q:FIELD="" D Q:$G(GECSFLAG)
|
---|
| 46 | . . . S SUB1=$P(FIELD,";",2)
|
---|
| 47 | . . . S Y=$P($G(DATA(SUB1)),"^",$P(FIELD,";",3))
|
---|
| 48 | . . . D SETLINE(2100,+FIELD)
|
---|
| 49 | . ; multiple field
|
---|
| 50 | . S SUB1=$P(GECSMAP(GECSNOD1),",",2)
|
---|
| 51 | . S DA1=0 F S DA1=$O(DATA(SUB1,DA1)) Q:'DA1 S GECSNOD2=0 F S GECSNOD2=$O(GECSMAP(GECSNOD1,GECSNOD2)) Q:'GECSNOD2 D
|
---|
| 52 | . . F PIECE=1:1 S FIELD=$P(GECSMAP(GECSNOD1,GECSNOD2),"\",PIECE) Q:FIELD="" D Q:$G(GECSFLAG)
|
---|
| 53 | . . . S SUB2=$P(FIELD,";",2)
|
---|
| 54 | . . . S Y=$P($G(DATA(SUB1,DA1,SUB2)),"^",$P(FIELD,";",3))
|
---|
| 55 | . . . D SETLINE(+$P(GECSMAP(GECSNOD1),",",3),+FIELD)
|
---|
| 56 | ;
|
---|
| 57 | ; put code sheet specific code here (after code sheets have been built)
|
---|
| 58 | ; reformat for amis
|
---|
| 59 | I $P(DATA(0),"^",2)="AMS" D AMIS
|
---|
| 60 | ; end of code sheet specific code
|
---|
| 61 | Q $$SHEET
|
---|
| 62 | ;
|
---|
| 63 | ;
|
---|
| 64 | SHEET() ; move code sheets to code node
|
---|
| 65 | D NOW^%DTC S GECSDATE=%
|
---|
| 66 | K ^GECS(2100,GECSDA,"CODE")
|
---|
| 67 | S GECSLINE="" F I=1:1 S GECSLINE=$O(CODESHET(GECSLINE)) Q:GECSLINE="" S ^GECS(2100,GECSDA,"CODE",I,0)=CODESHET(GECSLINE)
|
---|
| 68 | S I=I-1,^GECS(2100,GECSDA,"CODE",0)="^^"_I_"^"_I_"^"_$P(GECSDATE,".")_"^^"
|
---|
| 69 | D PRINT^GECSUTIL(GECSDA)
|
---|
| 70 | Q 1
|
---|
| 71 | ;
|
---|
| 72 | ;
|
---|
| 73 | SETLINE(FILE,FIELD) ; build codeshet array with data in y
|
---|
| 74 | I $D(^DD(FILE,+FIELD,2.1)),^(2.1)["GECSOT" X ^(2.1)
|
---|
| 75 | S CODESHET(GECSLINE)=$G(CODESHET(GECSLINE))_$S($G(CODESHET(GECSLINE))="":"",$G(CODESHET(GECSLINE))=("LIN^"_$C(126)):"",$P(DATA(0),"^",2)="FEN"&(Y="$"):"",1:DELIMITR)_Y
|
---|
| 76 | ; for fms, put each segment on a new line
|
---|
| 77 | I $P(DATA(0),"^",2)="FMS",Y=$C(126),$G(CODESHET(GECSLINE))'=("LIN^"_$C(126)) S GECSLINE=GECSLINE+1
|
---|
| 78 | I $L($G(CODESHET(GECSLINE)))>GECSEND S CODESHET(GECSLINE+1)=$E(CODESHET(GECSLINE),GECSEND+1,999),CODESHET(GECSLINE)=$E(CODESHET(GECSLINE),1,GECSEND),GECSLINE=GECSLINE+1
|
---|
| 79 | I Y="$" S GECSFLAG=1
|
---|
| 80 | Q
|
---|
| 81 | ;
|
---|
| 82 | ;
|
---|
| 83 | AMIS ; reformat for amis
|
---|
| 84 | N %,CHAR,LINE,OLDCODE,X
|
---|
| 85 | ; move code sheet (in codeshet) to temp variable for processing
|
---|
| 86 | K OLDCODE S %="" F S %=$O(CODESHET(%)) Q:%="" S OLDCODE(%)=CODESHET(%)
|
---|
| 87 | K CODESHET S GECSLINE=0
|
---|
| 88 | S CODESHET(0)=$E(OLDCODE(0),1,16)_"-",OLDCODE(0)=$E(OLDCODE(0),17,256)
|
---|
| 89 | S LINE="" F S LINE=$O(OLDCODE(LINE)) Q:LINE="" F CHAR=1:10 S X=$E(OLDCODE(LINE),CHAR,CHAR+9) Q:X="" D
|
---|
| 90 | . ; if x is not 10 characters long, move up data from next line
|
---|
| 91 | . I $L(X)<10,$D(OLDCODE(LINE+1)) S %=10-$L(X),X=X_$E(OLDCODE(LINE+1),1,%),OLDCODE(LINE+1)=$E(OLDCODE(LINE+1),%+1,256)
|
---|
| 92 | . I X="0000000000" S X=""
|
---|
| 93 | . S CODESHET(GECSLINE)=$G(CODESHET(GECSLINE))_X_$S(X["$":"",1:"-")
|
---|
| 94 | . I $L(CODESHET(GECSLINE))>GECSEND S CODESHET(GECSLINE+1)=$E(CODESHET(GECSLINE),GECSEND+1,256),CODESHET(GECSLINE)=$E(CODESHET(GECSLINE),1,GECSEND),GECSLINE=GECSLINE+1
|
---|
| 95 | Q
|
---|