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 ---[H[J[2J[HDGPTOLC1 1082 printed Oct 16, 2024@18:53:47 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
