APCLDMTX.m

APCLDMTX ; IHS/CMI/LAB - display audit logic ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 ;

 ;

EP ;EP - CALLED FROM OPTION

 ;select year

 S APCLYR=""

 W:$D(IOF) @IOF

 W !!,"Select the Audit Year",!!

 S DIC="^APCLDMTX(",DIC(0)="AEMQ" D ^DIC K DIC I Y=-1 W !!,"Goodbye" G EOJ

 S APCLYR=+Y

 D EN

 Q

EOJ ;EP

 D EN^XBVK("APCL")

 Q

 ;; ;

EN ; -- main entry point for APCL DM LOGIC DISPLAY

 D EN^VALM("APCL DM LOGIC DISPLAY")

 D CLEAR^VALM1

 D FULL^VALM1

 W:$D(IOF) @IOF

 D EOJ

 Q

 ;

HDR ; -- header code

 S VALMHDR(1)="DM Logic Display"

 Q

 ;

INIT ; -- init variables and list array

 K APCLDISP,APCLSEL,APCLHIGH,APCLLIST,APCLCSEL

 S APCLHIGH=0,X=0 F  S X=$O(^APCLDMTX(APCLYR,11,X)) Q:X'=+X  S APCLHIGH=APCLHIGH+1,APCLSEL(APCLHIGH)=X

 S APCLCUT=((APCLHIGH/3)+1)\1

 ;S APCLCUT=(APCLHIGH/3)\1

 S (C,I)=0,J=1,K=1 F  S I=$O(APCLSEL(I)) Q:I'=+I!($D(APCLDISP(I)))  D

 .S C=C+1,APCLLIST(C,0)=I_") "_$S($D(APCLCSEL(I)):"*",1:" ")_$E($P(^APCLDMTX(APCLYR,11,APCLSEL(I),0),U),1,20) S APCLDISP(I)="",APCLLIST("IDX",C,C)=APCLSEL(I)

 .S J=I+APCLCUT I $D(APCLSEL(J)),'$D(APCLDISP(J)) S $E(APCLLIST(C,0),28)=J_") "_$S($D(APCLCSEL(J)):"*",1:" ")_$E($P(^APCLDMTX(APCLYR,11,APCLSEL(J),0),U),1,20) S APCLDISP(J)="",APCLLIST("IDX",J,J)=APCLSEL(J)

 .S K=J+APCLCUT I $D(APCLSEL(K)),'$D(APCLDISP(K)) S $E(APCLLIST(C,0),55)=K_") "_$S($D(APCLCSEL(K)):"*",1:" ")_$E($P(^APCLDMTX(APCLYR,11,APCLSEL(K),0),U),1,20) S APCLDISP(K)="",APCLLIST("IDX",K,K)=APCLSEL(K)

 K APCLDISP

 S VALMCNT=C

 Q

 ;

HELP ; -- help code

 S X="?" D DISP^XQORM1 W !!

 Q

 ;

EXIT ; -- exit code

 Q

 ;

EXPND ; -- expand code

 Q

 ;

BACK ;go back to listman

 D TERM^VALM0

 S VALMBCK="R"

 D INIT

 D HDR

 K DIR

 K X,Y,Z,I

 Q

 ;

ADD ;EP - add an item to the selected list - called from a protocol

 W ! S DIR(0)="LO^1:"_APCLHIGH,DIR("A")="Which item(s)" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I Y="" W !,"No items selected." G ADDX

 I $D(DIRUT) W !,"No items selected." G ADDX

 D FULL^VALM1 W:$D(IOF) @IOF

 S APCLANS=Y,APCLC="" F APCLI=1:1 S APCLC=$P(APCLANS,",",APCLI) Q:APCLC=""  S APCLCSEL(APCLC)=""

 D DISPLAY

ADDX ;

 D BACK

 Q

ADDALL ;

 F X=1:1:APCLHIGH S APCLCSEL(X)=""

 D DISPLAY

 D BACK

 Q

 ;

DISPLAY ;gather in ^TMP and display

 K ^TMP("APCLDMTX",$J)

 S ^TMP("APCLDMTX",$J,0)=0

 S APCLC=0

 S APCLX=0 F  S APCLX=$O(APCLCSEL(APCLX)) Q:APCLX'=+APCLX  S APCLY=APCLLIST("IDX",APCLX,APCLX),Y=$P(^APCLDMTX(APCLYR,11,APCLY,0),U) S APCLC=APCLC+1 D S(Y,$S(APCLC=1:0,1:2),1) D

 .S Y=0 F  S Y=$O(^APCLDMTX(APCLYR,11,APCLY,11,Y)) Q:Y'=+Y  S Z=^APCLDMTX(APCLYR,11,APCLY,11,Y,0) D S(Z)

 .Q

 K ^TMP("APCLDMTX",$J,0)

 D ARRAY^XBLM("^TMP(""APCLDMTX"",$J,","DM AUDIT LOGIC DESCRIPTIONS")

 Q

S(Y,F,C,T) ;set up array

 I '$G(F) S F=0

 I '$G(T) S T=0

 ;blank lines

 F F=1:1:F S X="" D S1

 S X=Y

 I $G(C) S L=$L(Y),T=(80-L)/2 D  D S1 Q

 .F %=1:1:(T-1) S X=" "_X

 F %=1:1:T S X=" "_Y

 D S1

 Q

S1 ;

 S %=$P(^TMP("APCLDMTX",$J,0),U)+1,$P(^TMP("APCLDMTX",$J,0),U)=%

 S ^TMP("APCLDMTX",$J,%,0)=X

 Q

APCLDMTX  ; IHS/CMI/LAB - display audit logic ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ;

 +3       ;

EP        ;EP - CALLED FROM OPTION

 +1       ;select year

 +2        SET APCLYR=""

 +3        IF $DATA(IOF)

               WRITE @IOF

 +4        WRITE !!,"Select the Audit Year",!!

 +5        SET DIC="^APCLDMTX("

           SET DIC(0)="AEMQ"

           DO ^DIC

           KILL DIC

           IF Y=-1

               WRITE !!,"Goodbye"

               GOTO EOJ

 +6        SET APCLYR=+Y

 +7        DO EN

 +8        QUIT 

EOJ       ;EP

 +1        DO EN^XBVK("APCL")

 +2        QUIT 

 +3       ;; ;

EN        ; -- main entry point for APCL DM LOGIC DISPLAY

 +1        DO EN^VALM("APCL DM LOGIC DISPLAY")

 +2        DO CLEAR^VALM1

 +3        DO FULL^VALM1

 +4        IF $DATA(IOF)

               WRITE @IOF

 +5        DO EOJ

 +6        QUIT 

 +7       ;

HDR       ; -- header code

 +1        SET VALMHDR(1)="DM Logic Display"

 +2        QUIT 

 +3       ;

INIT      ; -- init variables and list array

 +1        KILL APCLDISP,APCLSEL,APCLHIGH,APCLLIST,APCLCSEL

 +2        SET APCLHIGH=0

           SET X=0

           FOR 

               SET X=$ORDER(^APCLDMTX(APCLYR,11,X))

               IF X'=+X

                   QUIT 

               SET APCLHIGH=APCLHIGH+1

               SET APCLSEL(APCLHIGH)=X

 +3        SET APCLCUT=((APCLHIGH/3)+1)\1

 +4       ;S APCLCUT=(APCLHIGH/3)\1

 +5        SET (C,I)=0

           SET J=1

           SET K=1

           FOR 

               SET I=$ORDER(APCLSEL(I))

               IF I'=+I!($DATA(APCLDISP(I)))

                   QUIT 

               Begin DoDot:1

 +6                SET C=C+1

                   SET APCLLIST(C,0)=I_") "_$SELECT($DATA(APCLCSEL(I)):"*",1:" ")_$EXTRACT($PIECE(^APCLDMTX(APCLYR,11,APCLSEL(I),0),U),1,20)

                   SET APCLDISP(I)=""

                   SET APCLLIST("IDX",C,C)=APCLSEL(I)

 +7                SET J=I+APCLCUT

                   IF $DATA(APCLSEL(J))

                       IF '$DATA(APCLDISP(J))

                           SET $EXTRACT(APCLLIST(C,0),28)=J_") "_$SELECT($DATA(APCLCSEL(J)):"*",1:" ")_$EXTRACT($PIECE(^APCLDMTX(APCLYR,11,APCLSEL(J),0),U),1,20)

                           SET APCLDISP(J)=""

                           SET APCLLIST("IDX",J,J)=APCLSEL(J)

 +8                SET K=J+APCLCUT

                   IF $DATA(APCLSEL(K))

                       IF '$DATA(APCLDISP(K))

                           SET $EXTRACT(APCLLIST(C,0),55)=K_") "_$SELECT($DATA(APCLCSEL(K)):"*",1:" ")_$EXTRACT($PIECE(^APCLDMTX(APCLYR,11,APCLSEL(K),0),U),1,20)

                           SET APCLDISP(K)=""

                           SET APCLLIST("IDX",K,K)=APCLSEL(K)

               End DoDot:1

 +9        KILL APCLDISP

 +10       SET VALMCNT=C

 +11       QUIT 

 +12      ;

HELP      ; -- help code

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !!

 +2        QUIT 

 +3       ;

EXIT      ; -- exit code

 +1        QUIT 

 +2       ;

EXPND     ; -- expand code

 +1        QUIT 

 +2       ;

BACK      ;go back to listman

 +1        DO TERM^VALM0

 +2        SET VALMBCK="R"

 +3        DO INIT

 +4        DO HDR

 +5        KILL DIR

 +6        KILL X,Y,Z,I

 +7        QUIT 

 +8       ;

ADD       ;EP - add an item to the selected list - called from a protocol

 +1        WRITE !

           SET DIR(0)="LO^1:"_APCLHIGH

           SET DIR("A")="Which item(s)"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF Y=""

               WRITE !,"No items selected."

               GOTO ADDX

 +3        IF $DATA(DIRUT)

               WRITE !,"No items selected."

               GOTO ADDX

 +4        DO FULL^VALM1

           IF $DATA(IOF)

               WRITE @IOF

 +5        SET APCLANS=Y

           SET APCLC=""

           FOR APCLI=1:1

               SET APCLC=$PIECE(APCLANS,",",APCLI)

               IF APCLC=""

                   QUIT 

               SET APCLCSEL(APCLC)=""

 +6        DO DISPLAY

ADDX      ;

 +1        DO BACK

 +2        QUIT 

ADDALL    ;

 +1        FOR X=1:1:APCLHIGH

               SET APCLCSEL(X)=""

 +2        DO DISPLAY

 +3        DO BACK

 +4        QUIT 

 +5       ;

DISPLAY   ;gather in ^TMP and display

 +1        KILL ^TMP("APCLDMTX",$JOB)

 +2        SET ^TMP("APCLDMTX",$JOB,0)=0

 +3        SET APCLC=0

 +4        SET APCLX=0

           FOR 

               SET APCLX=$ORDER(APCLCSEL(APCLX))

               IF APCLX'=+APCLX

                   QUIT 

               SET APCLY=APCLLIST("IDX",APCLX,APCLX)

               SET Y=$PIECE(^APCLDMTX(APCLYR,11,APCLY,0),U)

               SET APCLC=APCLC+1

               DO S(Y,$SELECT(APCLC=1:0,1:2),1)

               Begin DoDot:1

 +5                SET Y=0

                   FOR 

                       SET Y=$ORDER(^APCLDMTX(APCLYR,11,APCLY,11,Y))

                       IF Y'=+Y

                           QUIT 

                       SET Z=^APCLDMTX(APCLYR,11,APCLY,11,Y,0)

                       DO S(Z)

 +6                QUIT 

               End DoDot:1

 +7        KILL ^TMP("APCLDMTX",$JOB,0)

 +8        DO ARRAY^XBLM("^TMP(""APCLDMTX"",$J,","DM AUDIT LOGIC DESCRIPTIONS")

 +9        QUIT 

S(Y,F,C,T) ;set up array

 +1        IF '$GET(F)

               SET F=0

 +2        IF '$GET(T)

               SET T=0

 +3       ;blank lines

 +4        FOR F=1:1:F

               SET X=""

               DO S1

 +5        SET X=Y

 +6        IF $GET(C)

               SET L=$LENGTH(Y)

               SET T=(80-L)/2

               Begin DoDot:1

 +7                FOR %=1:1:(T-1)

                       SET X=" "_X

               End DoDot:1

               DO S1

               QUIT 

 +8        FOR %=1:1:T

               SET X=" "_Y

 +9        DO S1

 +10       QUIT 

S1        ;

 +1        SET %=$PIECE(^TMP("APCLDMTX",$JOB,0),U)+1

           SET $PIECE(^TMP("APCLDMTX",$JOB,0),U)=%

 +2        SET ^TMP("APCLDMTX",$JOB,%,0)=X

 +3        QUIT