[628] | 1 | SPNAHOCY ;HISC/DAD-AD HOC REPORTS: INTERFACE COMPILER ;9/9/96 11:44
|
---|
| 2 | ;;2.0;Spinal Cord Dysfunction;;01/02/1997
|
---|
| 3 | ;
|
---|
| 4 | S (SPNMMAX,SPNSORT)=0,SPNLEVEL=1,SPNFILE(SPNLEVEL)=SPNFILE
|
---|
| 5 | FLD ; *** Process the sort/print fields
|
---|
| 6 | W !!,"Choose a field for menu item number ",SPNMMAX+1
|
---|
| 7 | W ", <RETURN> to end, ^ to exit."
|
---|
| 8 | W !,"Select ",$S(SPNLEVEL=1:"",1:$P(SPNFILE(SPNLEVEL-1),U,3)_" SUB-")
|
---|
| 9 | W "FIELD: " R X:DTIME S:'$T X=U S SPNQUIT=$S($E(X)=U:1,1:0)
|
---|
| 10 | I X="?",SPNMMAX D LIST G:SPNQUIT FLD W !
|
---|
| 11 | K DIC S DIC="^DD("_+SPNFILE(SPNLEVEL)_",",DIC(0)="EMNQZ"
|
---|
| 12 | S DIC("W")="W "" "",$$ID^SPNAHOCY"
|
---|
| 13 | D ^DIC S SPNY=Y
|
---|
| 14 | I SPNY'>0 S:X="" SPNLEVEL=SPNLEVEL-1 G EXIT:'SPNLEVEL!SPNQUIT,FLD
|
---|
| 15 | S SPNATTR="LABEL;MULTIPLE-VALUED;POINTER;SPECIFIER;TYPE" K SPNDD,SPNERR
|
---|
| 16 | D FIELD^DID(+SPNFILE(SPNLEVEL),+SPNY,"",SPNATTR,"SPNDD","SPNERR")
|
---|
| 17 | I $O(SPNERR(""))]"" W " ??",$C(7) G FLD
|
---|
| 18 | S SPNDD=SPNDD("LABEL")_U_SPNDD("SPECIFIER")_U_SPNDD("POINTER")
|
---|
| 19 | S $P(SPNFILE(SPNLEVEL),U,2,3)=+SPNY_U_$P(SPNDD,U),SPNWP=0
|
---|
| 20 | ; *** SPNFILE(Level#) = Dict # ^ Fld # ^ Fld Name
|
---|
| 21 | I +$P(SPNDD,U,2) D G:'SPNWP FLD
|
---|
| 22 | . S SPNWP=(SPNDD("TYPE")="WORD-PROCESSING")
|
---|
| 23 | . I 'SPNWP S SPNLEVEL=SPNLEVEL+1,SPNFILE(SPNLEVEL)=+$P(SPNDD,U,2)
|
---|
| 24 | . Q
|
---|
| 25 | I $D(SPNCHOSN(SPNFILE(SPNLEVEL)))#2 D G FLD
|
---|
| 26 | . W !!?5,"*** You have already chosen that field !! ***",$C(7)
|
---|
| 27 | . Q
|
---|
| 28 | F SP=1:1:5 S SPNTEXT(SP)=""
|
---|
| 29 | NAME ; *** Prompt user for the external field name
|
---|
| 30 | K DIR S DIR(0)="FOA^2:30^K:X[U X",DIR("?")="^D EN^SPNAHOCH(""H7"")"
|
---|
| 31 | S DIR("A")="Menu text the user should see: "
|
---|
| 32 | S DIR("B")=$$CASE($P(SPNDD,U))
|
---|
| 33 | D ^DIR G:$D(DIRUT) FLD S SPNTEXT(2)=Y
|
---|
| 34 | SORT ; *** Allow sorting on this field (Y/N)
|
---|
| 35 | G:SPNWP SETLINE ; *** Don't ask sort questions for WP fields
|
---|
| 36 | F D Q:%
|
---|
| 37 | . S X=$P(SPNDD,U,2)
|
---|
| 38 | . S %=$S($P(SPNFILE(SPNLEVEL),U,2)=.01:1,X["F":2,X["K":2,X["V":2,1:1)
|
---|
| 39 | . W !,"Want to allow sorting by ",SPNTEXT(2)
|
---|
| 40 | . D YN^DICN S SPNTEXT(1)=(%=1),SPNSORT=SPNSORT+SPNTEXT(1)
|
---|
| 41 | . I '% W !!?5,SPNYESNO,!
|
---|
| 42 | . Q
|
---|
| 43 | G:%=-1 FLD
|
---|
| 44 | SCREEN ; *** Prompt user for screen on pointers and sets
|
---|
| 45 | S X=$P(SPNDD,U,2)
|
---|
| 46 | I SPNTEXT(1),$TR(X,$TR(X,"PS"))]"" D G:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) FLD
|
---|
| 47 | . F D Q:SPNTEXT(5)]""!$D(DIRUT)
|
---|
| 48 | .. K DIR S DIR(0)="FOAU^1:245^"
|
---|
| 49 | .. S DIR("A")="Sort from/to look-up screen: "
|
---|
| 50 | .. S DIR("?")="^D EN^SPNAHOCH(""H12"")"
|
---|
| 51 | .. D ^DIR I Y=""!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q
|
---|
| 52 | .. S X=Y D ^DIM
|
---|
| 53 | .. I $G(X)]"" S SPNTEXT(5)=X
|
---|
| 54 | .. E W " ??",$C(7)
|
---|
| 55 | .. Q
|
---|
| 56 | . Q
|
---|
| 57 | DIR ; *** Set up DIR(0) for sort from/to prompts
|
---|
| 58 | S X=$P(SPNDD,U,2)
|
---|
| 59 | G NUMERIC:X["N",POINTER:X["P",SET:X["S",DATE:X["D",TEXT
|
---|
| 60 | DATE S SPNTEXT(4)="DAO^::AETS^D DATE^SPNAHOC2" G SETLINE
|
---|
| 61 | NUMERIC S SPNTEXT(4)="NAO^-999999999:999999999:9^" G SETLINE
|
---|
| 62 | POINTER S SP=$P(SPNDD,U,2),SP=$TR(SP,$TR(SP,".0123456789"))
|
---|
| 63 | S SPNTEXT(4)="PAO^"_SP_":AEMNQZ^D POINTER^SPNAHOC2" G SETLINE
|
---|
| 64 | SET S SPNTEXT(4)="SAOM^"_$P(SPNDD,U,3)_"^D SET^SPNAHOC2" G SETLINE
|
---|
| 65 | TEXT S SPNTEXT(4)="FAO^1:60^"
|
---|
| 66 | SETLINE ; *** Save menu $TEXT line in ^TMP
|
---|
| 67 | F SP=1:1:SPNLEVEL S SPNTEXT(3)=SPNTEXT(3)_$S(SP=SPNLEVEL:"~",1:"")_$P(SPNFILE(SP),U,2)_$S(SP'=SPNLEVEL:",",1:$S(SPNTEXT(2)'=$P(SPNFILE(SP),U,3):";"""_$TR(SPNTEXT(2),",;^~"," ")_"""",1:""))
|
---|
| 68 | S Y=8+$L(SPNTEXT(2))+$L(SPNTEXT(3))+$L(SPNTEXT(4))+$L(SPNTEXT(5))-245
|
---|
| 69 | I Y>0 D G FLD
|
---|
| 70 | . W !!?5,"*** This line is ",Y," character",$S(Y>1:"s",1:"")
|
---|
| 71 | . W " too long, maximum is 245 !! ***",$C(7)
|
---|
| 72 | . Q
|
---|
| 73 | S SPNMMAX=SPNMMAX+1,SPNCHOSN(SPNFILE(SPNLEVEL))=""
|
---|
| 74 | S ^TMP($J,"SPNTXT",1000+SPNMMAX,0)=" ;;"_+SPNTEXT(1)_U_SPNTEXT(2)_U_SPNTEXT(3)_U_SPNTEXT(4)_"|"_SPNTEXT(5)
|
---|
| 75 | G FLD
|
---|
| 76 | EXIT ; *** Exit field questions loop
|
---|
| 77 | Q
|
---|
| 78 | LIST ; *** Display the fields already chosen
|
---|
| 79 | N X
|
---|
| 80 | W !!,"You have already selected the following: (Menu Item # Menu Text)",!
|
---|
| 81 | S SPN=$Y,SPNMMAX(0)=SPNMMAX#2+SPNMMAX\2
|
---|
| 82 | F SP=1001:1:SPNMMAX(0)+1000 D Q:SPNQUIT
|
---|
| 83 | . S SPI=SP,SPNTAB=0 D S SPI=SP+SPNMMAX(0),SPNTAB=40 D
|
---|
| 84 | .. S X=$P($G(^TMP($J,"SPNTXT",SPI,0)),";;",2,99)
|
---|
| 85 | .. Q:X="" W:SPNTAB=0 !
|
---|
| 86 | .. W ?SPNTAB,$S($P(X,U):$J(SPI-1000,2),1:" ")," ",$P(X,U,2)
|
---|
| 87 | .. Q
|
---|
| 88 | . I ($Y>(IOSL+SPN-4))!(SPNMMAX(0)+1000=SP) D
|
---|
| 89 | .. S SPN=$Y K DIR S DIR(0)="E" W ! D ^DIR K DIR S SPNQUIT=$S(Y'>0:1,1:0)
|
---|
| 90 | .. Q
|
---|
| 91 | . Q
|
---|
| 92 | Q
|
---|
| 93 | CASE(SPN) ; *** Convert text to initial capital letters
|
---|
| 94 | N X,SP S X=""
|
---|
| 95 | F SP=1:1:$L(SPN) D
|
---|
| 96 | . S X(0)=$E(SPN,SP-1),X(1)=$E(SPN,SP)
|
---|
| 97 | . S X=X_$S(X(0)?.1P:$$U(X(1)),X(0)?1U:$$L(X(1)),X(1)?1U:$$L(X(1)),1:X(1))
|
---|
| 98 | . Q
|
---|
| 99 | Q X
|
---|
| 100 | U(X) Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
---|
| 101 | L(X) Q $TR(X,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
|
---|
| 102 | ID() ; *** DD identifiers
|
---|
| 103 | N SPNDD,SPNERR,SPNID S SPNID=""
|
---|
| 104 | D FIELD^DID(+SPNFILE(SPNLEVEL),+Y,"","SPECIFIER;TYPE","SPNDD","SPNERR")
|
---|
| 105 | I $O(SPNERR(""))="" D
|
---|
| 106 | . I SPNDD("SPECIFIER") S SPNID="(multiple)"
|
---|
| 107 | . I SPNDD("TYPE")="WORD-PROCESSING" S SPNID="("_$$L(SPNDD("TYPE"))_")"
|
---|
| 108 | . Q
|
---|
| 109 | Q SPNID
|
---|