QAQAUTL.m

QAQAUTL ;HISC/DDA,DAD-UTILITY FOR QUALITY ASSURANCE MODULE ;7/12/93  14:16

 ;;1.7;QM Integration Module;;07/25/1995

EN1 ; INPUT TRANSFORM ON FIELDS #741.05 & 743.02 OF FILE #740

 ; FREE TEXT POINTER TO DEVICE FILE.  ALLOWS ONLY DEVICES WITH TERMINAL

 ; TYPES OF 'P-' OR 'PK-'.  STORED AS: DEVICE;IOST;IOM;IOSL.

 S DIC("S")="I $E($G(^%ZIS(2,+$G(^%ZIS(1,+Y,""SUBTYPE"")),0)))=""P"""

 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

 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:"")

1 K %ZIS,IOP,QAQA Q

EN2 ; ENTRY POINT FOR OUTPUT TRANSFORM ON FIELD #.02 OF FILE #740.5

 ; DISPLAYS FIELD #.01 ENTRY IN THE POINTED TO FILE

 S QAQADICT=^QA(740.5,D0,0),QAQAFLD=$P(QAQADICT,"^",2),QAQADICT=+QAQADICT

 Q:$D(^DIC(QAQADICT,0,"GL"))[0

 S Y=$S(Y'>0:Y,$D(@(^DIC(QAQADICT,0,"GL")_Y_",0)"))#2:$P(^(0),"^"),1:Y)

 S C=$P(^DD(QAQADICT,.01,0),"^",2) D Y^DIQ S Y=QAQAFLD_"  "_Y

 K QAQADICT,QAQAFLD

 Q

EN3(FILE,FIELD) ; ENTRY POINT FOR XECUTABLE HELP ON DEVICE FREE TEXT POINTER

 ; FIELDS: DISPLAYS THE FIELD DESCRIPTION AND DEVICES

 I $D(DZ)#2,DZ?1"?" G 3

 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)

 W !

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="?"

 D DQ^DICQ K DIC S DIC=DIE

 K QAQA Q

EN5 ; *** INPUT TRANSFORM ON FIELD 740,743.05

 S QAM="2359-2359" F QA=1,3,6,8 I $E(X,QA,QA+1)>$E(QAM,QA,QA+1) K X Q

 I $D(X) K:$P(X,"-",2)'>$P(X,"-") X

 K QA,QAM Q

EN6 ;*** CONFIDENTIALITY STATEMENT ***

 W !!,"**  This information is confidential in accordance with Title 38 U.S.C. 5705  **",!

 Q

EN7 ;*** PRIVACY STATEMENT ***

 W !!,"* This info is provided only for the purposes described in 38 U.S.C. 3301 (F) *",!

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---QAQAUTL   1963     printed  Apr 09, 2024@21:33:54                                                                                                                                                                                                     Page 2

QAQAUTL   ;HISC/DDA,DAD-UTILITY FOR QUALITY ASSURANCE MODULE ;7/12/93  14:16

 +1       ;;1.7;QM Integration Module;;07/25/1995

EN1       ; INPUT TRANSFORM ON FIELDS #741.05 & 743.02 OF FILE #740

 +1       ; FREE TEXT POINTER TO DEVICE FILE.  ALLOWS ONLY DEVICES WITH TERMINAL

 +2       ; TYPES OF 'P-' OR 'PK-'.  STORED AS: DEVICE;IOST;IOM;IOSL.

 +3        SET DIC("S")="I $E($G(^%ZIS(2,+$G(^%ZIS(1,+Y,""SUBTYPE"")),0)))=""P"""

 +4        SET DIC="^%ZIS(1,"

           SET DIC(0)="EMQ"

           DO ^DIC

           KILL DIC

           SET X=$PIECE(Y,"^",2)

           if $DATA(DIE)#2

               SET DIC=DIE

           if Y<0

               GOTO 1

 +5        KILL %ZIS

           SET %ZIS="NQ"

           SET (IOP,QAQA)=X

           DO ^%ZIS

           if POP

               SET Y=-1

           SET X=QAQA_";"_$SELECT($DATA(IOST)#2:IOST,1:"")_";"_$SELECT($DATA(IOM)#2:IOM,1:"")_";"_$SELECT($DATA(IOSL)#2:IOSL,1:"")

1          KILL %ZIS,IOP,QAQA

           QUIT 

EN2       ; ENTRY POINT FOR OUTPUT TRANSFORM ON FIELD #.02 OF FILE #740.5

 +1       ; DISPLAYS FIELD #.01 ENTRY IN THE POINTED TO FILE

 +2        SET QAQADICT=^QA(740.5,D0,0)

           SET QAQAFLD=$PIECE(QAQADICT,"^",2)

           SET QAQADICT=+QAQADICT

 +3        if $DATA(^DIC(QAQADICT,0,"GL"))[0

               QUIT 

 +4        SET Y=$SELECT(Y'>0:Y,$DATA(@(^DIC(QAQADICT,0,"GL")_Y_",0)"))#2:$PIECE(^(0),"^"),1:Y)

 +5        SET C=$PIECE(^DD(QAQADICT,.01,0),"^",2)

           DO Y^DIQ

           SET Y=QAQAFLD_"  "_Y

 +6        KILL QAQADICT,QAQAFLD

 +7        QUIT 

EN3(FILE,FIELD) ; ENTRY POINT FOR XECUTABLE HELP ON DEVICE FREE TEXT POINTER

 +1       ; FIELDS: DISPLAYS THE FIELD DESCRIPTION AND DEVICES

 +2        IF $DATA(DZ)#2

               IF DZ?1"?"

                   GOTO 3

 +3        FOR QAQA=0:0

               SET QAQA=$ORDER(^DD(FILE,FIELD,21,QAQA))

               if QAQA'>0

                   QUIT 

               if $DATA(^DD(FILE,FIELD,21,QAQA,0))#2

                   WRITE !,^(0)

 +4        WRITE !

3          SET DIC="^%ZIS(1,"

           SET DIC(0)="M"

           SET 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)"

           SET D="B"

           SET DZ="?"

 +1        DO DQ^DICQ

           KILL DIC

           SET DIC=DIE

 +2        KILL QAQA

           QUIT 

EN5       ; *** INPUT TRANSFORM ON FIELD 740,743.05

 +1        SET QAM="2359-2359"

           FOR QA=1,3,6,8

               IF $EXTRACT(X,QA,QA+1)>$EXTRACT(QAM,QA,QA+1)

                   KILL X

                   QUIT 

 +2        IF $DATA(X)

               if $PIECE(X,"-",2)'>$PIECE(X,"-")

                   KILL X

 +3        KILL QA,QAM

           QUIT 

EN6       ;*** CONFIDENTIALITY STATEMENT ***

 +1        WRITE !!,"**  This information is confidential in accordance with Title 38 U.S.C. 5705  **",!

 +2        QUIT 

EN7       ;*** PRIVACY STATEMENT ***

 +1        WRITE !!,"* This info is provided only for the purposes described in 38 U.S.C. 3301 (F) *",!

 +2        QUIT