DGPTFCR.m

DGPTFCR ;ALB/JDS - CREATE IN PATIENT PTF RECORD ; 11 JAN 85

 ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21

 ;

EN D LO^DGUTL F DGDUMB=0:0 K DFN D SEL Q:'$D(DFN)

Q K %,D0,DQ,T,Y,X,DGDUMB Q

 ;

SEL ; -- pt select

 W ! K DIC

 S DIC(0)="AEQMZ",DIC="^DPT(",DIC("S")="I $D(^DGPM(""APTT1"",+Y))",DIC("A")="Select Patient: "

 D ^DIC K DIC G SELQ:Y'>0 S DFN=+Y

 ;

 ; -- adm mvt select

 ; will change to use ^DGPM("ADFN") cross-reference when available

 W !

 S DIC(0)="EQZ",DIC="^DGPM(",DIC("S")="I $P(^(0),U,2)=1,'$P(^(0),U,26),'$D(^DGPT(+$P(^(0),U,16),0))",DIC("A")="Select Admission Date: "

 D DFN^DGPMUTL K DIC G SELQ:Y'>0

 ;

 N DGPMCA,DGPMAN,DGPMDN

 S DGPMCA=+Y,DGPMAN=Y(0),DGPMDN=$S($D(^DGPM(+$P(DGPMAN,"^",17),0)):^(0),1:""),DGTY=$S($D(^DG(405.2,+$P(DGPMDN,"^",18),0)):$P(^(0),"^",8),1:0)

 S Y=1 D RTY^DGPTUTL S Y=+DGPMAN

 W !!?5,"Creating new PTF record..."

 D CREATE I +Y<0 W *7,"unable to create record." G SELQ

 S PTF=+Y,DR="[DG PTF ATTACH]",DIE="^DGPM(",DA=DGPMCA D ^DIE

 W !?5,"record #",PTF," created.",!

SELQ K DR,X,DA,DIE,DIC,DGTY,DGRTY,DGRTY0,PTF,I,J,Y,DQ,DG Q

 ;

CREATE ; -- entry point to create a new PTF record

 ;    input:   DFN := pt number

 ;               Y := admission d/t ^ fee record

 ;           DGRTY := type of record (1-PTF ; 2-CENSUS)

 ;                    (PTF assumed if undefined)

 ;   output:     Y := ifn of ^DGPT

 ;

 I $S('$D(DFN):1,'DFN:1,1:'Y) S Y=-1,Y(0)="" G CREATEQ

 S DGPTDATA=U_Y,DIC="^DGPT(",DIC("DR")="[DG PTF CREATE PTF ENTRY]"

 S DIC(0)="FLZ",X=DFN K DD,DO D FILE^DICN S Y=+Y

 I $S('$D(DGRTY):1,1:DGRTY=1) N PTF K DA S (PTF,DA)=Y,DIE="^DGPT(",DR="[DG PTF POST CREATE]" D ^DIE:DA>0 S Y=PTF

CREATEQ K DA,DIC,DGPTDATA,DIE,DR Q

DGPTFCR   ;ALB/JDS - CREATE IN PATIENT PTF RECORD ; 11 JAN 85

 +1       ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21

 +2       ;

EN         DO LO^DGUTL

           FOR DGDUMB=0:0

               KILL DFN

               DO SEL

               IF '$DATA(DFN)

                   QUIT 

Q          KILL %,D0,DQ,T,Y,X,DGDUMB

           QUIT 

 +1       ;

SEL       ; -- pt select

 +1        WRITE !

           KILL DIC

 +2        SET DIC(0)="AEQMZ"

           SET DIC="^DPT("

           SET DIC("S")="I $D(^DGPM(""APTT1"",+Y))"

           SET DIC("A")="Select Patient: "

 +3        DO ^DIC

           KILL DIC

           IF Y'>0

               GOTO SELQ

           SET DFN=+Y

 +4       ;

 +5       ; -- adm mvt select

 +6       ; will change to use ^DGPM("ADFN") cross-reference when available

 +7        WRITE !

 +8        SET DIC(0)="EQZ"

           SET DIC="^DGPM("

           SET DIC("S")="I $P(^(0),U,2)=1,'$P(^(0),U,26),'$D(^DGPT(+$P(^(0),U,16),0))"

           SET DIC("A")="Select Admission Date: "

 +9        DO DFN^DGPMUTL

           KILL DIC

           IF Y'>0

               GOTO SELQ

 +10      ;

 +11       NEW DGPMCA,DGPMAN,DGPMDN

 +12       SET DGPMCA=+Y

           SET DGPMAN=Y(0)

           SET DGPMDN=$SELECT($DATA(^DGPM(+$PIECE(DGPMAN,"^",17),0)):^(0),1:"")

           SET DGTY=$SELECT($DATA(^DG(405.2,+$PIECE(DGPMDN,"^",18),0)):$PIECE(^(0),"^",8),1:0)

 +13       SET Y=1

           DO RTY^DGPTUTL

           SET Y=+DGPMAN

 +14       WRITE !!?5,"Creating new PTF record..."

 +15       DO CREATE

           IF +Y<0

               WRITE *7,"unable to create record."

               GOTO SELQ

 +16       SET PTF=+Y

           SET DR="[DG PTF ATTACH]"

           SET DIE="^DGPM("

           SET DA=DGPMCA

           DO ^DIE

 +17       WRITE !?5,"record #",PTF," created.",!

SELQ       KILL DR,X,DA,DIE,DIC,DGTY,DGRTY,DGRTY0,PTF,I,J,Y,DQ,DG

           QUIT 

 +1       ;

CREATE    ; -- entry point to create a new PTF record

 +1       ;    input:   DFN := pt number

 +2       ;               Y := admission d/t ^ fee record

 +3       ;           DGRTY := type of record (1-PTF ; 2-CENSUS)

 +4       ;                    (PTF assumed if undefined)

 +5       ;   output:     Y := ifn of ^DGPT

 +6       ;

 +7        IF $SELECT('$DATA(DFN):1,'DFN:1,1:'Y)

               SET Y=-1

               SET Y(0)=""

               GOTO CREATEQ

 +8        SET DGPTDATA=U_Y

           SET DIC="^DGPT("

           SET DIC("DR")="[DG PTF CREATE PTF ENTRY]"

 +9        SET DIC(0)="FLZ"

           SET X=DFN

           KILL DD,DO

           DO FILE^DICN

           SET Y=+Y

 +10       IF $SELECT('$DATA(DGRTY):1,1:DGRTY=1)

               NEW PTF

               KILL DA

               SET (PTF,DA)=Y

               SET DIE="^DGPT("

               SET DR="[DG PTF POST CREATE]"

               IF DA>0

                   DO ^DIE

               SET Y=PTF

CREATEQ    KILL DA,DIC,DGPTDATA,DIE,DR

           QUIT