DGPTOLC1.m

DGPTOLC1 ;ALB/AS - SUMMARY by ADM Rpt, lists diagnoses, sur, pro ; 2 AUG 88 @ 1300

 ;;5.3;Registration;;Aug 13, 1993

 ;

 D LO^DGUTL S DGPTF=0,DIC="^DGPT(",DIC(0)="EQMZ",DIC("S")="I $P(^(0),U,11)=1"

 F PTF=1:0:20 W !,"Select ",$S(PTF>1:"another",1:"PTF PATIENT") R " RECORD: ",DGX:DTIME D HELP:DGX["?" Q:DGX=""!(DGX["^")!('$T)  S X=DGX D ^DIC I Y>0 D PAT

 G:DGX["^"!('$T) Q I $D(DGPTF)'=11 W !,"no PTF Patient Records selected" G Q

 S DGPGM="EN^DGPTOLC2",DGVAR="DGPTF#^DUZ" D ZIS^DGUTQ G:POP Q U IO G EN^DGPTOLC2

PAT S DGNAME=$P(^DPT(+^DGPT(+Y,0),0),"^"),DGADM=$P(^DGPT(+Y,0),"^",2) Q:$D(DGPTF(+Y))

 S DGPTF(+Y)=DGNAME_"^"_DGADM,PTF=PTF+1 Q

Q K DGADM,DGNAME,DGPGM,DGPTF,DGVAR,DIC,POP,PTF,DGX,X,Y Q

HELP W !?4,"Enter PTF record # or patient name",!?4,"You may select up to 20 PTF Patient Records",!?4,"Enter <RETURN> when all desired PTF Patient Records have been selected" Q

Q2 W ! D CLOSE^DGUTQ K DGADM,DGBS,DGC,DGDT,DGELIG,DGF,DGFEE,DGICD,DGLOS,DGLV,DGM,DGNAME,DGPG,DGMD,DGPGM,DGPRO,DGPT,DGPTF,DFN,DGPTX,DGS,DGSTAT,DGSUR,DGVAR,DG70,DGPMIFN,D1,DIC,POP,PTF,X,Y,X1,X2,% Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DGPTOLC1   1082     printed  Apr 09, 2024@21:57:15                                                                                                                                                                                                    Page 2

DGPTOLC1  ;ALB/AS - SUMMARY by ADM Rpt, lists diagnoses, sur, pro ; 2 AUG 88 @ 1300

 +1       ;;5.3;Registration;;Aug 13, 1993

 +2       ;

 +3        DO LO^DGUTL

           SET DGPTF=0

           SET DIC="^DGPT("

           SET DIC(0)="EQMZ"

           SET DIC("S")="I $P(^(0),U,11)=1"

 +4        FOR PTF=1:0:20

               WRITE !,"Select ",$SELECT(PTF>1:"another",1:"PTF PATIENT")

               READ " RECORD: ",DGX:DTIME

               if DGX["?"

                   DO HELP

               if DGX=""!(DGX["^")!('$TEST)

                   QUIT 

               SET X=DGX

               DO ^DIC

               IF Y>0

                   DO PAT

 +5        if DGX["^"!('$TEST)

               GOTO Q

           IF $DATA(DGPTF)'=11

               WRITE !,"no PTF Patient Records selected"

               GOTO Q

 +6        SET DGPGM="EN^DGPTOLC2"

           SET DGVAR="DGPTF#^DUZ"

           DO ZIS^DGUTQ

           if POP

               GOTO Q

           USE IO

           GOTO EN^DGPTOLC2

PAT        SET DGNAME=$PIECE(^DPT(+^DGPT(+Y,0),0),"^")

           SET DGADM=$PIECE(^DGPT(+Y,0),"^",2)

           if $DATA(DGPTF(+Y))

               QUIT 

 +1        SET DGPTF(+Y)=DGNAME_"^"_DGADM

           SET PTF=PTF+1

           QUIT 

Q          KILL DGADM,DGNAME,DGPGM,DGPTF,DGVAR,DIC,POP,PTF,DGX,X,Y

           QUIT 

HELP       WRITE !?4,"Enter PTF record # or patient name",!?4,"You may select up to 20 PTF Patient Records",!?4,"Enter <RETURN> when all desired PTF Patient Records have been selected"

           QUIT 

Q2         WRITE !

           DO CLOSE^DGUTQ

           KILL DGADM,DGBS,DGC,DGDT,DGELIG,DGF,DGFEE,DGICD,DGLOS,DGLV,DGM,DGNAME,DGPG,DGMD,DGPGM,DGPRO,DGPT,DGPTF,DFN,DGPTX,DGS,DGSTAT,DGSUR,DGVAR,DG70,DGPMIFN,D1,DIC,POP,PTF,X,Y,X1,X2,%

           QUIT