DG3PR ;ALB/JDS - THIRD PARTY REIMBURSMENT ;01 JAN 1987
;;5.3;Registration;;Aug 13, 1993
EN W ! R "Sort by Discharge or Admission: D// ",X:DTIME S Z="^DISCHARGE^ADMISSION" Q:X["^"!'$T I X="" S X="D" W X
D IN^DGHELP I %<0 W !!,"CHOOSE FROM",!?4,"A - ADMISSION",!?4,"D - DISCHARGE",!?4,"^ - To QUIT",! G EN
S DGBY=$S(X="D":"ATT3",1:"ATT1")
DAT S %DT(0)="-DT",%DT="AEPX",%DT("A")="START DATE: " D ^%DT G Q:X["^",DAT:Y<0 S DGFR=Y-.1
S %DT("A")=" END DATE: ",%DT(0)=DGFR+.1,%DT="AEPX" D ^%DT G Q:X["^",DAT:Y<0 S DGTO=Y_.9
S DGVAR="DGBY^DGFR^DGTO",DGPGM="SORT^DG3PR1" D ZIS^DGUTQ I 'POP D SORT^DG3PR1
Q K %,%DT,C,DFN,DGAD,DGBY,DGCA,DGDC,DGFL,DGFR,DGI,DGJ,DGLOL,DGNOW,DGPGM,DGPMIFN,DGPR,DGPTF,DGTIME,DGTO,DGTR,DGVAR,DIR,DIROUT,DIRUT,DTOUT,DUOUT,I,J,K,L,M,POP,X,X1,X2,Y,Z,^UTILITY("DG",$J) D CLOSE^DGUTQ,KVAR^VADPT Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG3PR 824 printed Nov 22, 2024@17:45:27 Page 2
DG3PR ;ALB/JDS - THIRD PARTY REIMBURSMENT ;01 JAN 1987
+1 ;;5.3;Registration;;Aug 13, 1993
EN WRITE !
READ "Sort by Discharge or Admission: D// ",X:DTIME
SET Z="^DISCHARGE^ADMISSION"
if X["^"!'$TEST
QUIT
IF X=""
SET X="D"
WRITE X
+1 DO IN^DGHELP
IF %<0
WRITE !!,"CHOOSE FROM",!?4,"A - ADMISSION",!?4,"D - DISCHARGE",!?4,"^ - To QUIT",!
GOTO EN
+2 SET DGBY=$SELECT(X="D":"ATT3",1:"ATT1")
DAT SET %DT(0)="-DT"
SET %DT="AEPX"
SET %DT("A")="START DATE: "
DO ^%DT
if X["^"
GOTO Q
if Y<0
GOTO DAT
SET DGFR=Y-.1
+1 SET %DT("A")=" END DATE: "
SET %DT(0)=DGFR+.1
SET %DT="AEPX"
DO ^%DT
if X["^"
GOTO Q
if Y<0
GOTO DAT
SET DGTO=Y_.9
+2 SET DGVAR="DGBY^DGFR^DGTO"
SET DGPGM="SORT^DG3PR1"
DO ZIS^DGUTQ
IF 'POP
DO SORT^DG3PR1
Q KILL %,%DT,C,DFN,DGAD,DGBY,DGCA,DGDC,DGFL,DGFR,DGI,DGJ,DGLOL,DGNOW,DGPGM,DGPMIFN,DGPR,DGPTF,DGTIME,DGTO,DGTR,DGVAR,DIR,DIROUT,DIRUT,DTOUT,DUOUT,I,J,K,L,M,POP,X,X1,X2,Y,Z,^UTILITY("DG",$JOB)
DO CLOSE^DGUTQ
DO KVAR^VADPT
QUIT
