- 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 Jan 18, 2025@03:36:09 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