| [613] | 1 | GECSDG ;WISC/RFJ-pims dggecsb patch routine ;01 Nov 93
|
|---|
| 2 | ;;2.0;GCS;;MAR 14, 1995
|
|---|
| 3 | DGGECSB ;ALB/DMK/CMM - MAS PRINT A CODE SHEET ; 07/20/89
|
|---|
| 4 | ;;5.3;REGISTRATION;**47**;Aug 13, 1993
|
|---|
| 5 | ;
|
|---|
| 6 | PRINT N DIC
|
|---|
| 7 | S DIC="^GECS(2100,",DIC(0)="AEQMZ",DIC("A")="Select MAS Code Sheet ID: "
|
|---|
| 8 | S DIC("S")="I $P(^(0),U,8)>333&($P(^(0),U,8)<342)!($P(^(0),U,8)>400)&($P(^(0),U,8)<421)!($P(^(0),U,8)=223)!($P(^(0),U,8)=345)!($P(^(0),U,8)=346)!($P(^(0),U,8)=167)!($P(^(0),U,8)=290)"
|
|---|
| 9 | W ! D ^DIC G END:X=""!(X="^"),PRINT:Y<0
|
|---|
| 10 | S HY=Y(0,0),CSDA=+Y,(FR,TO)=Y(0,0),BY="@.01",FLDS="[GECS TRANSMIT LIST]"
|
|---|
| 11 | S GECS("TTF")=$P(Y(0),"^",8)
|
|---|
| 12 | I $D(^GECS(2100,+Y,"KEY")) G KEY
|
|---|
| 13 | K DIC,Y,X
|
|---|
| 14 | D FIELD
|
|---|
| 15 | S L=0,DHD="MAS CODE SHEET ID # : "_FR,DIC="^GECS(2100,",DIOEND="D READ^DGGECSB",ZTSAVE("^UTILITY(""DIQ1"",$J,")="",ZTSAVE("HDR")="",ZTSAVE("CSDA")=""
|
|---|
| 16 | D EN1^DIP G PRINT
|
|---|
| 17 | END K CSDA,TO,FR,BY,FLDS,HY,L,DHD,DA,DR,DIQ,HDR,GECSMAP,GECSTT,GECS,HY
|
|---|
| 18 | K GECSEDIT,DIOEND
|
|---|
| 19 | K ^UTILITY("DIQ1",$J)
|
|---|
| 20 | Q
|
|---|
| 21 | FIELD S GECSTT=$G(GECS("TTF"))
|
|---|
| 22 | S GECSEDIT=$P($G(^GECS(2101.2,+$O(^GECS(2101.2,"B",GECSTT,0)),0)),"^",3) I GECSEDIT="" Q
|
|---|
| 23 | S GECSEDIT=$E(GECSEDIT,2,$L(GECSEDIT)-1)
|
|---|
| 24 | ;strip off [ ]
|
|---|
| 25 | N ENT
|
|---|
| 26 | S ENT=$O(^DIE("B",GECSEDIT,0)) I 'ENT Q
|
|---|
| 27 | D GETMAP^GECSXMAP(ENT) I '$D(GECSMAP) Q
|
|---|
| 28 | ;Build DR string from GECSMAP
|
|---|
| 29 | N DIC,DA,DR,FR,TO,Y,BY,FLDS,L,DHD,SLASH,PP,NEXT,SEMI,LOOP
|
|---|
| 30 | S DIC="^GECS(2100,",DA=CSDA,DR="9.1;1;"
|
|---|
| 31 | F LOOP=1:1:GECSMAP D
|
|---|
| 32 | .S NEXT=GECSMAP(LOOP)
|
|---|
| 33 | .I LOOP>1 S N1=GECSMAP(LOOP-1),N1=$E(N1,$L(N1)-2,$L(N1)),NEXT=N1_NEXT K N1
|
|---|
| 34 | .S SLASH=$F(NEXT,"\"),SEMI=$F(NEXT,";",SLASH)
|
|---|
| 35 | .F S PP=$E(NEXT,SLASH,SEMI-2) Q:PP="" D
|
|---|
| 36 | ..S DR=DR_PP_";"
|
|---|
| 37 | ..S NEXT=$E(NEXT,SEMI,$L(NEXT))
|
|---|
| 38 | ..S SLASH=$F(NEXT,"\"),SEMI=$F(NEXT,";",SLASH)
|
|---|
| 39 | S DR=$E(DR,1,$L(DR)-1),DIQ(0)="E",HDR=DR
|
|---|
| 40 | K ^UTILITY("DIQ1",$J)
|
|---|
| 41 | D EN^DIQ1
|
|---|
| 42 | Q
|
|---|
| 43 | READ ;
|
|---|
| 44 | N ENT,ADAT,LOOP,PRT,HEAD
|
|---|
| 45 | F LOOP=1:1 S ENT=$P(HDR,";",LOOP) Q:ENT="" D
|
|---|
| 46 | .W !,$P(^DD(2100,ENT,0),"^")_": "_^UTILITY("DIQ1",$J,2100,CSDA,ENT,"E")
|
|---|
| 47 | .I LOOP=1 W !
|
|---|
| 48 | K ^UTILITY("DIQ1",$J)
|
|---|
| 49 | Q
|
|---|
| 50 | KEY ;PRINT KEYPUNCH CODE SHEET
|
|---|
| 51 | K ^UTILITY("DIQ1",$J)
|
|---|
| 52 | D H1
|
|---|
| 53 | S BY="@.01",FLDS="51;C1;""",L=0,DIC="^GECS(2100,"
|
|---|
| 54 | S DHD="W ?0 D HEAD^DGGECSB W ?0 ;PRINT KEYPUNCH CODESHEET"
|
|---|
| 55 | S ZTSAVE("^UTILITY(""DIQ1"",$J,")="",ZTSAVE("DHD")="",ZTSAVE("CSDA")="",ZTSAVE("DIOEND")=""
|
|---|
| 56 | D EN1^DIP G PRINT
|
|---|
| 57 | H1 ;
|
|---|
| 58 | N DR,DIC,DA K ^UTILITY("DIQ1",$J)
|
|---|
| 59 | S DR="9.1",DIC="^GECS(2100,",DA=CSDA,DIQ(0)="E"
|
|---|
| 60 | D EN^DIQ1
|
|---|
| 61 | S HDR=DR
|
|---|
| 62 | Q
|
|---|
| 63 | HEAD ;
|
|---|
| 64 | S QQ="",$P(QQ,"+",79)="+"
|
|---|
| 65 | S MD=$O(^UTILITY("DIQ1",$J,2100,CSDA,0)),MD=^UTILITY("DIQ1",$J,2100,CSDA,MD,"E") K ^UTILITY("DIQ1",$J,2100,CSDA,MD,"E") S HDR=$P(HDR,";",2)
|
|---|
| 66 | W !!,?5,"MAS KEYPUNCH CODE SHEET ID#: "_HY
|
|---|
| 67 | W ?50,$P(^DD(2100,"9.1",0),"^")_": "_MD,!,QQ,!
|
|---|
| 68 | D READ W !
|
|---|
| 69 | K QQ,MD
|
|---|
| 70 | Q
|
|---|
