AGSAMPP.m

AGSAMPP ; IHS/ASDS/EFG - PRINT LIST OF SAMPLED PATIENTS ;  

 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005

 G NOSAMP:'$D(^AGSAMPLE(0)),NOSAMP:'$O(^AGSAMPLE(0))

 W @IOF,?20,"***   PRINT LIST OF SAMPLED PATIENTS FOR   ***",!!

 S AGV("SITNUM")=^AGSAMPLE(0),AGV("SITNM")=$P(^DIC(4,AGV("SITNUM"),0),U)

 W ?80-$L(AGV("SITNM"))/2,AGV("SITNM"),!!

 S %ZIS="P" D ^%ZIS I POP S IOP=ION D ^%ZIS G END

 S (R,AGPGPG)=0,AGV("SDIG")="" U IO D HEADER

A3 S R=$O(^AGSAMPLE(R)) G END:R=""

 S AGRR=0

A4 S AGRR=$O(^AGSAMPLE(R,AGRR)) G A3:AGRR=""

 S X=^AGSAMPLE(R,AGRR),AGV("TDIG")=$P(X,U),AGHRN=$P(X,U,2),AGNAME=$P(X,U,3)

 I AGV("TDIG")'=AGV("SDIG") W !

 W !,$J(AGV("TDIG"),5),?10,$J(AGHRN,6),?20,AGNAME

 S AGV("SDIG")=AGV("TDIG")

 I $Y>55 D HEADER

 G A4

END D ^%ZISC

 K AGHRN,I,AGNAME,AGPGPG,R,AGRR,AGV("SDIG"),AGV("SITNM"),AGV("SITNUM"),AGV("TDIG"),X,Y

 Q

HEADER S AGPGPG=AGPGPG+1 W @IOF F I=1:1:50 W "*"

 W !?5,"SAMPLE CHARTS FOR REGISTRATION STUDY   pg ",$J(AGPGPG,3),!?50-$L(AGV("SITNM"))/2,AGV("SITNM"),! F I=1:1:50 W "-"

 W !,"T-DIGIT",?10,"CHART #",?20,"PATIENT NAME" W ! F I=1:1:50 W "*"

 W !!

 Q

NOSAMP W *7,!!,"Sampling does not exist.",!!,"Generate first.",!!,"Press RETURN..." R X:DTIME

 Q

AGSAMPP   ; IHS/ASDS/EFG - PRINT LIST OF SAMPLED PATIENTS ;  

 +1       ;;7.1;PATIENT REGISTRATION;;AUG 25,2005

 +2        IF '$DATA(^AGSAMPLE(0))

               GOTO NOSAMP

           IF '$ORDER(^AGSAMPLE(0))

               GOTO NOSAMP

 +3        WRITE @IOF,?20,"***   PRINT LIST OF SAMPLED PATIENTS FOR   ***",!!

 +4        SET AGV("SITNUM")=^AGSAMPLE(0)

           SET AGV("SITNM")=$PIECE(^DIC(4,AGV("SITNUM"),0),U)

 +5        WRITE ?80-$LENGTH(AGV("SITNM"))/2,AGV("SITNM"),!!

 +6        SET %ZIS="P"

           DO ^%ZIS

           IF POP

               SET IOP=ION

               DO ^%ZIS

               GOTO END

 +7        SET (R,AGPGPG)=0

           SET AGV("SDIG")=""

           USE IO

           DO HEADER

A3         SET R=$ORDER(^AGSAMPLE(R))

           IF R=""

               GOTO END

 +1        SET AGRR=0

A4         SET AGRR=$ORDER(^AGSAMPLE(R,AGRR))

           IF AGRR=""

               GOTO A3

 +1        SET X=^AGSAMPLE(R,AGRR)

           SET AGV("TDIG")=$PIECE(X,U)

           SET AGHRN=$PIECE(X,U,2)

           SET AGNAME=$PIECE(X,U,3)

 +2        IF AGV("TDIG")'=AGV("SDIG")

               WRITE !

 +3        WRITE !,$JUSTIFY(AGV("TDIG"),5),?10,$JUSTIFY(AGHRN,6),?20,AGNAME

 +4        SET AGV("SDIG")=AGV("TDIG")

 +5        IF $Y>55

               DO HEADER

 +6        GOTO A4

END        DO ^%ZISC

 +1        KILL AGHRN,I,AGNAME,AGPGPG,R,AGRR,AGV("SDIG"),AGV("SITNM"),AGV("SITNUM"),AGV("TDIG"),X,Y

 +2        QUIT 

HEADER     SET AGPGPG=AGPGPG+1

           WRITE @IOF

           FOR I=1:1:50

               WRITE "*"

 +1        WRITE !?5,"SAMPLE CHARTS FOR REGISTRATION STUDY   pg ",$JUSTIFY(AGPGPG,3),!?50-$LENGTH(AGV("SITNM"))/2,AGV("SITNM"),!

           FOR I=1:1:50

               WRITE "-"

 +2        WRITE !,"T-DIGIT",?10,"CHART #",?20,"PATIENT NAME"

           WRITE !

           FOR I=1:1:50

               WRITE "*"

 +3        WRITE !!

 +4        QUIT 

NOSAMP     WRITE *7,!!,"Sampling does not exist.",!!,"Generate first.",!!,"Press RETURN..."

           READ X:DTIME

 +1        QUIT