APCLUTL.m

APCLUTL ; IHS/CMI/LAB - Area Database Utility Routine ;

 ;;2.0;IHS PCC SUITE;**6**;MAY 14, 2009;Build 11

 ;

DEMO(P,T) ;EP - called to exclude demo patients

 I $G(P)="" Q 0

 I $G(T)="" S T="I"

 I T="I" Q 0

 NEW R

 S R=""

 I T="E" D  Q R

 .I $P($G(^DPT(P,0)),U)["DEMO,PATIENT" S R=1 Q

 .NEW %

 .S %=$O(^DIBT("B","RPMS DEMO PATIENT NAMES",0))

 .I '% S R=0 Q

 .I $D(^DIBT(%,1,P)) S R=1 Q

 I T="O" D  Q R

 .I $P($G(^DPT(P,0)),U)["DEMO,PATIENT" S R=0 Q

 .NEW %

 .S %=$O(^DIBT("B","RPMS DEMO PATIENT NAMES",0))

 .I '% S R=1 Q

 .I $D(^DIBT(%,1,P)) S R=0 Q

 .S R=1 Q

 Q 0

 ;

RZERO(V,L) ;ep right zero fill 

 NEW %,I

 S %=$L(V),Z=L-% F I=1:1:Z S V=V_"0"

 Q V

LZERO(V,L) ;EP - left zero fill

 NEW %,I

 S %=$L(V),Z=L-% F I=1:1:Z S V="0"_V

 Q V

LBLK(V,L) ;EP - left blank fill

 NEW %,I

 S %=$L(V),Z=L-% F I=1:1:Z S V=" "_V

 Q V

RBLK(V,L) ;EP right blank fill

 NEW %,I

 S %=$L(V),Z=L-% F I=1:1:Z S V=V_" "

 Q V

 ;

DEMOCHK(R) ;EP - check demo pat

 NEW DIR,DA

 S R=-1

 S DIR(0)="S^I:Include ALL Patients;E:Exclude DEMO Patients;O:Include ONLY DEMO Patients",DIR("A")="Demo Patient Inclusion/Exclusion",DIR("B")="E"

 KILL DA D ^DIR KILL DIR

 I $D(DIRUT) S R=-1 Q

 S R=Y

 Q

APCLUTL   ; IHS/CMI/LAB - Area Database Utility Routine ;

 +1       ;;2.0;IHS PCC SUITE;**6**;MAY 14, 2009;Build 11

 +2       ;

DEMO(P,T) ;EP - called to exclude demo patients

 +1        IF $GET(P)=""

               QUIT 0

 +2        IF $GET(T)=""

               SET T="I"

 +3        IF T="I"

               QUIT 0

 +4        NEW R

 +5        SET R=""

 +6        IF T="E"

               Begin DoDot:1

 +7                IF $PIECE($GET(^DPT(P,0)),U)["DEMO,PATIENT"

                       SET R=1

                       QUIT 

 +8                NEW %

 +9                SET %=$ORDER(^DIBT("B","RPMS DEMO PATIENT NAMES",0))

 +10               IF '%

                       SET R=0

                       QUIT 

 +11               IF $DATA(^DIBT(%,1,P))

                       SET R=1

                       QUIT 

               End DoDot:1

               QUIT R

 +12       IF T="O"

               Begin DoDot:1

 +13               IF $PIECE($GET(^DPT(P,0)),U)["DEMO,PATIENT"

                       SET R=0

                       QUIT 

 +14               NEW %

 +15               SET %=$ORDER(^DIBT("B","RPMS DEMO PATIENT NAMES",0))

 +16               IF '%

                       SET R=1

                       QUIT 

 +17               IF $DATA(^DIBT(%,1,P))

                       SET R=0

                       QUIT 

 +18               SET R=1

                   QUIT 

               End DoDot:1

               QUIT R

 +19       QUIT 0

 +20      ;

RZERO(V,L) ;ep right zero fill 

 +1        NEW %,I

 +2        SET %=$LENGTH(V)

           SET Z=L-%

           FOR I=1:1:Z

               SET V=V_"0"

 +3        QUIT V

LZERO(V,L) ;EP - left zero fill

 +1        NEW %,I

 +2        SET %=$LENGTH(V)

           SET Z=L-%

           FOR I=1:1:Z

               SET V="0"_V

 +3        QUIT V

LBLK(V,L) ;EP - left blank fill

 +1        NEW %,I

 +2        SET %=$LENGTH(V)

           SET Z=L-%

           FOR I=1:1:Z

               SET V=" "_V

 +3        QUIT V

RBLK(V,L) ;EP right blank fill

 +1        NEW %,I

 +2        SET %=$LENGTH(V)

           SET Z=L-%

           FOR I=1:1:Z

               SET V=V_" "

 +3        QUIT V

 +4       ;

DEMOCHK(R) ;EP - check demo pat

 +1        NEW DIR,DA

 +2        SET R=-1

 +3        SET DIR(0)="S^I:Include ALL Patients;E:Exclude DEMO Patients;O:Include ONLY DEMO Patients"

           SET DIR("A")="Demo Patient Inclusion/Exclusion"

           SET DIR("B")="E"

 +4        KILL DA

           DO ^DIR

           KILL DIR

 +5        IF $DATA(DIRUT)

               SET R=-1

               QUIT 

 +6        SET R=Y

 +7        QUIT