DGPMV301 ;ALB/MIR - ENTER TRANSACTION INFORMATION; 8 MAY 89 ;5/8/91 08:08
;;5.3;Registration;**34,271**;Aug 13, 1993
;
; This is the continuation of DGPMV3
;
NEW ;Entry point to add a new entry to ^DGPM
;INPUT: DGPM0ND=0 node of new entry.
;OUTPUT: Y=IFN of new entry created
;
;X is set to the date/time from +DGPM0ND
N DGMVTYPE
K DINUM I '$D(DGNOW) D NOW^%DTC S DGNOW=% K %
S DGMVTYPE=$P(DGPM0ND,"^",2)
I "^3^5^"[("^"_DGMVTYPE_"^") S ^UTILITY("DGPM",$J,$S(DGMVTYPE=3:1,1:4),+$P(DGPM0ND,"^",14),"P")=$G(^DGPM(+$P(DGPM0ND,"^",14),0)) ; have to catch change in 17th piece for ev driver
S X=+DGPM0ND,(DIK,DIC)="^DGPM(",DIC(0)="L" K DD,DO D FILE^DICN S DGX=Y I "^1^4^"[("^"_$P(DGPM0ND,"^",2)_"^") S $P(DGPM0ND,"^",14)=+Y
S DA=+Y L +^DGPM(+Y) S ^DGPM(+Y,0)=DGPM0ND,^("USR")=DUZ_"^"_DGNOW
D
.N DGX ;Preserve DGX Variable for L - Statement
.D IX1^DIK
L -^DGPM(+DGX)
S Y=DGX K DGX
I "^3^5^"[("^"_DGMVTYPE_"^") S ^UTILITY("DGPM",$J,$S(DGMVTYPE=3:1,1:4),+$P(DGPM0ND,"^",14),"A")=$G(^DGPM(+$P(DGPM0ND,"^",14),0)) ; have to catch change in 17th piece for ev driver
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPMV301 1116 printed Dec 13, 2024@02:50:15 Page 2
DGPMV301 ;ALB/MIR - ENTER TRANSACTION INFORMATION; 8 MAY 89 ;5/8/91 08:08
+1 ;;5.3;Registration;**34,271**;Aug 13, 1993
+2 ;
+3 ; This is the continuation of DGPMV3
+4 ;
NEW ;Entry point to add a new entry to ^DGPM
+1 ;INPUT: DGPM0ND=0 node of new entry.
+2 ;OUTPUT: Y=IFN of new entry created
+3 ;
+4 ;X is set to the date/time from +DGPM0ND
+5 NEW DGMVTYPE
+6 KILL DINUM
IF '$DATA(DGNOW)
DO NOW^%DTC
SET DGNOW=%
KILL %
+7 SET DGMVTYPE=$PIECE(DGPM0ND,"^",2)
+8 ; have to catch change in 17th piece for ev driver
IF "^3^5^"[("^"_DGMVTYPE_"^")
SET ^UTILITY("DGPM",$JOB,$SELECT(DGMVTYPE=3:1,1:4),+$PIECE(DGPM0ND,"^",14),"P")=$GET(^DGPM(+$PIECE(DGPM0ND,"^",14),0))
+9 SET X=+DGPM0ND
SET (DIK,DIC)="^DGPM("
SET DIC(0)="L"
KILL DD,DO
DO FILE^DICN
SET DGX=Y
IF "^1^4^"[("^"_$PIECE(DGPM0ND,"^",2)_"^")
SET $PIECE(DGPM0ND,"^",14)=+Y
+10 SET DA=+Y
LOCK +^DGPM(+Y)
SET ^DGPM(+Y,0)=DGPM0ND
SET ^("USR")=DUZ_"^"_DGNOW
+11 Begin DoDot:1
+12 ;Preserve DGX Variable for L - Statement
NEW DGX
+13 DO IX1^DIK
End DoDot:1
+14 LOCK -^DGPM(+DGX)
+15 SET Y=DGX
KILL DGX
+16 ; have to catch change in 17th piece for ev driver
IF "^3^5^"[("^"_DGMVTYPE_"^")
SET ^UTILITY("DGPM",$JOB,$SELECT(DGMVTYPE=3:1,1:4),+$PIECE(DGPM0ND,"^",14),"A")=$GET(^DGPM(+$PIECE(DGPM0ND,"^",14),0))
+17 QUIT
