DGPTFEE.m

DGPTFEE ;ALB/MRY - PTF VistA/FPPS (create/delete) DRIVER ; 2/11/04 1:12pm

 ;;5.3;Registration;**605**;Aug 13, 1993

 ;

 Q

 ;

CREATE(DFN,DGDTTM,DGFLAG) ; create Fee PTF

 ;Input

 ;  DFN     := Patient ien

 ;  DGDTTM  := Date.Time

 ;  DGFLAG  := Fee patient flag (value is 1)

 ;

 ;Output

 ;  Y       := returns newly created PTF ien (successful)

 ;          or, -1 (unsuccessful, patient ien not defined)

 ;

 N Y

 I DGFLAG'=1 Q 0

 S Y=DGDTTM_"^"_DGFLAG

 D CREATE^DGPTFCR

 Q Y

 ;

DELETE(DFN,DGDTTM) ; Delete Fee PTF entry

 ;Input

 ;  DFN      := Patient ien

 ;  DGDTTM   := Date.Time

 ;

 ;Output

 ;  1 := delete successful, -1 := unsuccessful

 ;

 N DA,DIK

 S DA=$O(^DGPT("AFEE",DFN,DGDTTM,0))

 I $S('$G(DA):1,$D(^DGP(45.84,DA)):1,$D(^DGP(45.83,"C",DA)):1,1:0) G ERR

 S DIK="^DGPT(" D ^DIK

 Q 1

ERR Q -1

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DGPTFEE   833     printed  Apr 09, 2024@21:53:11                                                                                                                                                                                                      Page 2

DGPTFEE   ;ALB/MRY - PTF VistA/FPPS (create/delete) DRIVER ; 2/11/04 1:12pm

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

 +2       ;

 +3        QUIT 

 +4       ;

CREATE(DFN,DGDTTM,DGFLAG) ; create Fee PTF

 +1       ;Input

 +2       ;  DFN     := Patient ien

 +3       ;  DGDTTM  := Date.Time

 +4       ;  DGFLAG  := Fee patient flag (value is 1)

 +5       ;

 +6       ;Output

 +7       ;  Y       := returns newly created PTF ien (successful)

 +8       ;          or, -1 (unsuccessful, patient ien not defined)

 +9       ;

 +10       NEW Y

 +11       IF DGFLAG'=1

               QUIT 0

 +12       SET Y=DGDTTM_"^"_DGFLAG

 +13       DO CREATE^DGPTFCR

 +14       QUIT Y

 +15      ;

DELETE(DFN,DGDTTM) ; Delete Fee PTF entry

 +1       ;Input

 +2       ;  DFN      := Patient ien

 +3       ;  DGDTTM   := Date.Time

 +4       ;

 +5       ;Output

 +6       ;  1 := delete successful, -1 := unsuccessful

 +7       ;

 +8        NEW DA,DIK

 +9        SET DA=$ORDER(^DGPT("AFEE",DFN,DGDTTM,0))

 +10       IF $SELECT('$GET(DA):1,$DATA(^DGP(45.84,DA)):1,$DATA(^DGP(45.83,"C",DA)):1,1:0)

               GOTO ERR

 +11       SET DIK="^DGPT("

           DO ^DIK

 +12       QUIT 1

ERR        QUIT -1