- DGMTCOU ;ALB/CAW/HM - Copay Utilities ; 12/10/92
- ;;5.3;Registration;**45,182,972**;Aug 13, 1993;Build 80
- ;
- EDT(DFN,DGDT) ;Display patients current copay test information and provide
- ; the user with the option of proceeding with adding a
- ; copay test or editing an existing copay test
- ; Input -- DFN Patient IEN
- ; DGDT Date/Time
- ; Output -- None
- ;
- ;
- N DGMTERR,SOURCE,DGMTYPT
- S DGMTYPT=2
- ;
- ; obtain lock used to synchronize local MT/CT options with income test upload
- I $$LOCK^DGMTUTL(DFN)
- ;
- S DGMTI=+$$LST^DGMTU(DFN,DGDT,2)
- S DGMT0=$G(^DGMT(408.31,DGMTI,0)),DGMTDT=+DGMT0 S DGMTS=$P(DGMT0,"^",3)
- I $$YR(DFN,DGDT,+DGMT0) S DGMTS=""
- G:$P($$RXST^IBARXEU(DFN,DT),U,3)=2010&('$$YR(DFN,DT,DGMTI)) EDTQ I $P($G(^DPT(DFN,.54)),"^")="Y" D DISP^IBARXEU(DFN,DGDT,2) W ! ;DG*5.3*972 HM if MOH="Y" do not display
- ;
- ;If test is uneditable, print error message and allow user to view test
- S SOURCE=$P($G(^DGMT(408.31,DGMTI,0)),U,23)
- I SOURCE,'$P($G(^DG(408.34,SOURCE,0)),U,2) D D:$G(DGMTERR) DISPLAY^DGMTU23(DGMTI,2),PAUSE^DGMTE G EDTQ
- .W !,"The source of this test makes the test uneditable."
- .S DIR("A")="Would you like to view the copay test",DIR("B")="NO",DIR(0)="Y"
- .D ^DIR K DIR S DGMTERR=Y I $D(DTOUT)!($D(DUOUT)) K DGMTERR,DTOUT,DUOUT
- ;
- S DIR("A")="Do you wish to "_$S(DGMTS="":"add a",1:"edit the")_" copay test at this time"
- S DIR("B")=$S(DGMTS=10:"YES",1:"NO"),DIR(0)="Y"
- W ! D ^DIR G EDTQ:$D(DTOUT)!($D(DUOUT))
- I Y,DGMTS]"" S DGMTYPT=2,DGMTACT="EDT",DGMTROU="EDTQ^DGMTCOU" G EN^DGMTSC
- I Y,DGMTS="" S DGMTYPT=2,DGMTACT="ADD",DGMTROU="EDTQ^DGMTCOU" S DGMTDT=DT D ADD^DGMTA G EN^DGMTSC
- EDTQ K DGMT0,DGMTACT,DGMTDT,DGMTI,DGMTROU,DGMTS,DIR,Y
- ;
- ; release lock used to synchronize local MT/CT options with income test upload
- D UNLOCK^DGMTUTL(DFN)
- Q
- ;
- YR(DFN,DGDT,DGMT0) ;Check to see if test is greater than 365 days
- ; Input -- DFN Patient IEN
- ; DGDT Date/Time to check against
- ; DGMT0 Zeroth node of Copay test
- ; Output -- 1 = TEST IS 365 OR MORE DAYS OLD
- ; 0 = TEST IS LESS THAN 365 DAYS OLD
- ;
- N X,X1,X2,DGLDYR,DGY S DGY=1
- S DGLDYR=$E(DGMT0,1,3)_"1231"
- I DGMTI S X1=DGDT,X2=$P(DGMT0,U,2) D ^%DTC I X<365,DGDT'>DGLDYR S DGY=0
- Q DGY
- ;
- ON ; Check to see of copay software is on
- ; Input - none
- ; Output - 1 = YES
- ; 0 = NO
- I $P(^DG(43,1,0),U,41) S Y=1 Q
- S Y=0
- Q
- ASKNW() ;
- Q 0
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMTCOU 2524 printed Jan 18, 2025@03:45:22 Page 2
- DGMTCOU ;ALB/CAW/HM - Copay Utilities ; 12/10/92
- +1 ;;5.3;Registration;**45,182,972**;Aug 13, 1993;Build 80
- +2 ;
- EDT(DFN,DGDT) ;Display patients current copay test information and provide
- +1 ; the user with the option of proceeding with adding a
- +2 ; copay test or editing an existing copay test
- +3 ; Input -- DFN Patient IEN
- +4 ; DGDT Date/Time
- +5 ; Output -- None
- +6 ;
- +7 ;
- +8 NEW DGMTERR,SOURCE,DGMTYPT
- +9 SET DGMTYPT=2
- +10 ;
- +11 ; obtain lock used to synchronize local MT/CT options with income test upload
- +12 IF $$LOCK^DGMTUTL(DFN)
- +13 ;
- +14 SET DGMTI=+$$LST^DGMTU(DFN,DGDT,2)
- +15 SET DGMT0=$GET(^DGMT(408.31,DGMTI,0))
- SET DGMTDT=+DGMT0
- SET DGMTS=$PIECE(DGMT0,"^",3)
- +16 IF $$YR(DFN,DGDT,+DGMT0)
- SET DGMTS=""
- +17 ;DG*5.3*972 HM if MOH="Y" do not display
- if $PIECE($$RXST^IBARXEU(DFN,DT),U,3)=2010&('$$YR(DFN,DT,DGMTI))
- GOTO EDTQ
- IF $PIECE($GET(^DPT(DFN,.54)),"^")="Y"
- DO DISP^IBARXEU(DFN,DGDT,2)
- WRITE !
- +18 ;
- +19 ;If test is uneditable, print error message and allow user to view test
- +20 SET SOURCE=$PIECE($GET(^DGMT(408.31,DGMTI,0)),U,23)
- +21 IF SOURCE
- IF '$PIECE($GET(^DG(408.34,SOURCE,0)),U,2)
- Begin DoDot:1
- +22 WRITE !,"The source of this test makes the test uneditable."
- +23 SET DIR("A")="Would you like to view the copay test"
- SET DIR("B")="NO"
- SET DIR(0)="Y"
- +24 DO ^DIR
- KILL DIR
- SET DGMTERR=Y
- IF $DATA(DTOUT)!($DATA(DUOUT))
- KILL DGMTERR,DTOUT,DUOUT
- End DoDot:1
- if $GET(DGMTERR)
- DO DISPLAY^DGMTU23(DGMTI,2)
- DO PAUSE^DGMTE
- GOTO EDTQ
- +25 ;
- +26 SET DIR("A")="Do you wish to "_$SELECT(DGMTS="":"add a",1:"edit the")_" copay test at this time"
- +27 SET DIR("B")=$SELECT(DGMTS=10:"YES",1:"NO")
- SET DIR(0)="Y"
- +28 WRITE !
- DO ^DIR
- if $DATA(DTOUT)!($DATA(DUOUT))
- GOTO EDTQ
- +29 IF Y
- IF DGMTS]""
- SET DGMTYPT=2
- SET DGMTACT="EDT"
- SET DGMTROU="EDTQ^DGMTCOU"
- GOTO EN^DGMTSC
- +30 IF Y
- IF DGMTS=""
- SET DGMTYPT=2
- SET DGMTACT="ADD"
- SET DGMTROU="EDTQ^DGMTCOU"
- SET DGMTDT=DT
- DO ADD^DGMTA
- GOTO EN^DGMTSC
- EDTQ KILL DGMT0,DGMTACT,DGMTDT,DGMTI,DGMTROU,DGMTS,DIR,Y
- +1 ;
- +2 ; release lock used to synchronize local MT/CT options with income test upload
- +3 DO UNLOCK^DGMTUTL(DFN)
- +4 QUIT
- +5 ;
- YR(DFN,DGDT,DGMT0) ;Check to see if test is greater than 365 days
- +1 ; Input -- DFN Patient IEN
- +2 ; DGDT Date/Time to check against
- +3 ; DGMT0 Zeroth node of Copay test
- +4 ; Output -- 1 = TEST IS 365 OR MORE DAYS OLD
- +5 ; 0 = TEST IS LESS THAN 365 DAYS OLD
- +6 ;
- +7 NEW X,X1,X2,DGLDYR,DGY
- SET DGY=1
- +8 SET DGLDYR=$EXTRACT(DGMT0,1,3)_"1231"
- +9 IF DGMTI
- SET X1=DGDT
- SET X2=$PIECE(DGMT0,U,2)
- DO ^%DTC
- IF X<365
- IF DGDT'>DGLDYR
- SET DGY=0
- +10 QUIT DGY
- +11 ;
- ON ; Check to see of copay software is on
- +1 ; Input - none
- +2 ; Output - 1 = YES
- +3 ; 0 = NO
- +4 IF $PIECE(^DG(43,1,0),U,41)
- SET Y=1
- QUIT
- +5 SET Y=0
- +6 QUIT
- ASKNW() ;
- +1 QUIT 0