| [613] | 1 | QAQAUTL ;HISC/DDA,DAD-UTILITY FOR QUALITY ASSURANCE MODULE ;7/12/93 14:16
|
|---|
| 2 | ;;1.7;QM Integration Module;;07/25/1995
|
|---|
| 3 | EN1 ; INPUT TRANSFORM ON FIELDS #741.05 & 743.02 OF FILE #740
|
|---|
| 4 | ; FREE TEXT POINTER TO DEVICE FILE. ALLOWS ONLY DEVICES WITH TERMINAL
|
|---|
| 5 | ; TYPES OF 'P-' OR 'PK-'. STORED AS: DEVICE;IOST;IOM;IOSL.
|
|---|
| 6 | S DIC("S")="I $E($G(^%ZIS(2,+$G(^%ZIS(1,+Y,""SUBTYPE"")),0)))=""P"""
|
|---|
| 7 | S DIC="^%ZIS(1,",DIC(0)="EMQ" D ^DIC K DIC S X=$P(Y,"^",2) S:$D(DIE)#2 DIC=DIE G:Y<0 1
|
|---|
| 8 | K %ZIS S %ZIS="NQ",(IOP,QAQA)=X D ^%ZIS S:POP Y=-1 S X=QAQA_";"_$S($D(IOST)#2:IOST,1:"")_";"_$S($D(IOM)#2:IOM,1:"")_";"_$S($D(IOSL)#2:IOSL,1:"")
|
|---|
| 9 | 1 K %ZIS,IOP,QAQA Q
|
|---|
| 10 | EN2 ; ENTRY POINT FOR OUTPUT TRANSFORM ON FIELD #.02 OF FILE #740.5
|
|---|
| 11 | ; DISPLAYS FIELD #.01 ENTRY IN THE POINTED TO FILE
|
|---|
| 12 | S QAQADICT=^QA(740.5,D0,0),QAQAFLD=$P(QAQADICT,"^",2),QAQADICT=+QAQADICT
|
|---|
| 13 | Q:$D(^DIC(QAQADICT,0,"GL"))[0
|
|---|
| 14 | S Y=$S(Y'>0:Y,$D(@(^DIC(QAQADICT,0,"GL")_Y_",0)"))#2:$P(^(0),"^"),1:Y)
|
|---|
| 15 | S C=$P(^DD(QAQADICT,.01,0),"^",2) D Y^DIQ S Y=QAQAFLD_" "_Y
|
|---|
| 16 | K QAQADICT,QAQAFLD
|
|---|
| 17 | Q
|
|---|
| 18 | EN3(FILE,FIELD) ; ENTRY POINT FOR XECUTABLE HELP ON DEVICE FREE TEXT POINTER
|
|---|
| 19 | ; FIELDS: DISPLAYS THE FIELD DESCRIPTION AND DEVICES
|
|---|
| 20 | I $D(DZ)#2,DZ?1"?" G 3
|
|---|
| 21 | F QAQA=0:0 S QAQA=$O(^DD(FILE,FIELD,21,QAQA)) Q:QAQA'>0 W:$D(^DD(FILE,FIELD,21,QAQA,0))#2 !,^(0)
|
|---|
| 22 | W !
|
|---|
| 23 | 3 S DIC="^%ZIS(1,",DIC(0)="M",DIC("W")="S QAQA=$S($D(^(1)):"" ""_^(1),1:"""") W:$X+$L(X)>78 !?79-$L(X) W $P(QAQA,""^""),"" "",$P(^(0),""^"",2),"" "",$P(^(0),""^"",9)",D="B",DZ="?"
|
|---|
| 24 | D DQ^DICQ K DIC S DIC=DIE
|
|---|
| 25 | K QAQA Q
|
|---|
| 26 | EN5 ; *** INPUT TRANSFORM ON FIELD 740,743.05
|
|---|
| 27 | S QAM="2359-2359" F QA=1,3,6,8 I $E(X,QA,QA+1)>$E(QAM,QA,QA+1) K X Q
|
|---|
| 28 | I $D(X) K:$P(X,"-",2)'>$P(X,"-") X
|
|---|
| 29 | K QA,QAM Q
|
|---|
| 30 | EN6 ;*** CONFIDENTIALITY STATEMENT ***
|
|---|
| 31 | W !!,"** This information is confidential in accordance with Title 38 U.S.C. 5705 **",!
|
|---|
| 32 | Q
|
|---|
| 33 | EN7 ;*** PRIVACY STATEMENT ***
|
|---|
| 34 | W !!,"* This info is provided only for the purposes described in 38 U.S.C. 3301 (F) *",!
|
|---|
| 35 | Q
|
|---|
