DGPMGLC ;ALB/XAK,JDS,MJK,LM - G&L CORRECTIONS ;10 AUG 84 15:19
;;5.3;Registration;**36,59,170**;Aug 13, 1993
;
;
EN ;
I $D(DGPMPC) G KILL ; if provider change, only, does not make entry in corrections file.
I DGHNYT<16 N DGADTM,DFN S DFN=$P(^DGPM(DA,0),U,3),DGADTM=$S($D(^DGPM(+$P(^(0),U,14),0)):+^(0),1:"")
I DGHNYT=13!(DGHNYT=14) S IVD=$O(^DGPM("ATS",DFN,+$P(^DGPM(DA,0),"^",14),9999999.9999999-$P(^DGPM(DA,0),U))) I IVD S DGTS=$O(^DGPM("ATS",DFN,+$P(^DGPM(DA,0),"^",14),IVD,0)) I DGTS S DGOTS=$S($D(^DIC(45.7,+DGTS,0)):$P(^(0),U),1:"") Q:DGTS=X
S H=$P($H,",",2),H=DT+(H\3600/100)+(H\60#60/10000) I $D(DGIDX) S H=DGIDX,W=H\1 K ^DGS(43.5,"AGL",+$P(^DGS(43.5,H,0),U,8)\1,H) G BR
LOCK L ^DGS(43.5,H):1 I '$T!$D(^DGS(43.5,H)) L S H=H+.00001 G LOCK
S DGIDX=H,W=H\1,^DGS(43.5,H,0)=W,^DGS(43.5,"B",W,H)="",^DGS(43.5,"C",DFN,H)="",^(0)=$P(^DGS(43.5,0),"^",1,2)_"^"_H_"^"_($P(^(0),"^",4)+1),^DISV(DUZ,"^DGS(43.5,")=H L
BR ;
; -- get adm d/t
G 3:DGHNYT=3,3:DGHNYT=6,3:DGHNYT=9,2:DGHNYT=2,2:DGHNYT=5,2:DGHNYT=8,1:DGHNYT<10,FTS:DGHNYT=13,2:DGHNYT=14,FTS:DGHNYT=15,@DGHNYT
Z S Z=$E(X,1,12),Z=$$FMTE^XLFDT(Z,"5F"),Z=$TR(Z," ","0"),Z=$TR(Z,":") Q
1 ; ADM,XFR,DIS ENTERED
D Z S ^DGS(43.5,H,0)=W_"^"_DGHNYT_"^^"_Z_"^"_DFN_"^"_DGADTM_"^"_DUZ_U_$P(X,"."),^DGS(43.5,"AGL",$P(X,"."),H)="" K DGIDX,DGHNYT Q
2 ; ADM,XFR,DIS,FACILITY TS DELETED
N X S X=+^DGPM(DA,0) ; gets date/time of mvt
D Z S ^DGS(43.5,H,0)=W_"^"_DGHNYT_"^"_Z_"^^"_DFN_"^"_DGADTM_"^"_DUZ_U_$P(X,".")_$S(DGHNYT=5:U_X,1:""),^DGS(43.5,"AGL",$P(X,"."),H)="" K DGHNYT Q
3 ; ADM,XFR,DIS DATE EDITED
D Z,NUM S DGED=$S(DGED&(DGED<X):DGED,1:X)\1,^(0)=W_"^"_DGHNYT_"^"_$P(^DGS(43.5,H,0),"^",3)_"^"_Z_"^"_DFN_"^"_DGADTM_"^"_DUZ_U_DGED,^DGS(43.5,"AGL",DGED,H)="" K DGIDX,DGED,DGHNYT Q
10 ; ADM WARD EDITED
S ^DGS(43.5,H,0)=W_"^10^"_$S($D(DGOWD):DGOWD,1:"")_"^"_$S($D(^DIC(42,+X,0)):$P(^(0),"^",1),1:X)_"^"_DFN_"^"_DGADTM_"^"_DUZ_U_$P(DGADTM,"."),^DGS(43.5,"AGL",$P(DGADTM,"."),H)="" K DGOWD,DGIDX,DGHNYT Q
11 ; MAS TYPE EDITED
S L=+^DGPM(DA,0),^DGS(43.5,H,0)=W_"^11^"_$S($D(DGOTY):DGOTY,1:"")_"^"_$S($D(^DG(405.2,+X,0)):$P(^(0),"^",1),1:X)_"^"_DFN_"^"_DGADTM_"^"_DUZ_U_$P(L,".")_U_L,^DGS(43.5,"AGL",$P(L,"."),H)="" K DGOTY,DGIDX,DGHNYT Q
12 ; XFR WARD EDITED
S L=+^DGPM(DA,0),^DGS(43.5,H,0)=W_"^12^"_$S($D(DGOWD):DGOWD,1:"")_"^"_$S($D(^DIC(42,+X,0)):$P(^(0),"^",1),1:X)_"^"_DFN_"^"_DGADTM_"^"_DUZ_U_$P(L,".")_U_L,^DGS(43.5,"AGL",$P(L,"."),H)="" K DGOWD,DGIDX,DGHNYT Q
Q
FTS ; FACILITY TS
; 13 = ENTERED
; 14 = DELETED
; 15 = FACILITY TS DATE EDITED
;S IVD=$O(^DGPM("ATS",DFN,+$P(^DGPM(DA,0),"^",14),9999999.9999999-$P(^DGPM(DA,0),U))) S:IVD DGTS=$O(^DGPM("ATS",DFN,+$P(^DGPM(DA,0),"^",14),IVD,0)) S:DGTS DGOTS=$S($D(^DIC(45.7,+DGTS,0)):$P(^(0),U),1:"") Q:DGTS=X
I DGHNYT=15 D Z
S L=+^DGPM(DA,0),^DGS(43.5,H,0)=W_"^"_DGHNYT_"^"_$S(DGHNYT=15:$P(^DGS(43.5,H,0),"^",3),$D(DGOTS):DGOTS,1:"")_"^"_$S(DGHNYT=15:"",$D(^DIC(45.7,+X,0)):$P(^(0),"^",1),1:X)_"^"_DFN_"^"_DGADTM_"^"_DUZ_U_$P(L,".")_U_L
S ^DGS(43.5,"AGL",$P(L,"."),H)="" ; sets flag in G&L Corrections file
KILL K DGOTS,DGIDX,DGHNYT,DGTS,IVD Q
Q
NUM S DGX=X,%DT="",X=$P($P(^DGS(43.5,H,0),U,3),"@",1) D ^%DT S DGED=$P(+Y,"."),X=DGX K DGX Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPMGLC 3204 printed Sep 23, 2025@20:25:29 Page 2
DGPMGLC ;ALB/XAK,JDS,MJK,LM - G&L CORRECTIONS ;10 AUG 84 15:19
+1 ;;5.3;Registration;**36,59,170**;Aug 13, 1993
+2 ;
+3 ;
EN ;
+1 ; if provider change, only, does not make entry in corrections file.
IF $DATA(DGPMPC)
GOTO KILL
+2 IF DGHNYT<16
NEW DGADTM,DFN
SET DFN=$PIECE(^DGPM(DA,0),U,3)
SET DGADTM=$SELECT($DATA(^DGPM(+$PIECE(^(0),U,14),0)):+^(0),1:"")
+3 IF DGHNYT=13!(DGHNYT=14)
SET IVD=$ORDER(^DGPM("ATS",DFN,+$PIECE(^DGPM(DA,0),"^",14),9999999.9999999-$PIECE(^DGPM(DA,0),U)))
IF IVD
SET DGTS=$ORDER(^DGPM("ATS",DFN,+$PIECE(^DGPM(DA,0),"^",14),IVD,0))
IF DGTS
SET DGOTS=$SELECT($DATA(^DIC(45.7,+DGTS,0)):$PIECE(^(0),U),1:"")
if DGTS=X
QUIT
+4 SET H=$PIECE($HOROLOG,",",2)
SET H=DT+(H\3600/100)+(H\60#60/10000)
IF $DATA(DGIDX)
SET H=DGIDX
SET W=H\1
KILL ^DGS(43.5,"AGL",+$PIECE(^DGS(43.5,H,0),U,8)\1,H)
GOTO BR
LOCK LOCK ^DGS(43.5,H):1
IF '$TEST!$DATA(^DGS(43.5,H))
LOCK
SET H=H+.00001
GOTO LOCK
+1 SET DGIDX=H
SET W=H\1
SET ^DGS(43.5,H,0)=W
SET ^DGS(43.5,"B",W,H)=""
SET ^DGS(43.5,"C",DFN,H)=""
SET ^(0)=$PIECE(^DGS(43.5,0),"^",1,2)_"^"_H_"^"_($PIECE(^(0),"^",4)+1)
SET ^DISV(DUZ,"^DGS(43.5,")=H
LOCK
BR ;
+1 ; -- get adm d/t
+2 if DGHNYT=3
GOTO 3
if DGHNYT=6
GOTO 3
if DGHNYT=9
GOTO 3
if DGHNYT=2
GOTO 2
if DGHNYT=5
GOTO 2
if DGHNYT=8
GOTO 2
if DGHNYT<10
GOTO 1
if DGHNYT=13
GOTO FTS
if DGHNYT=14
GOTO 2
if DGHNYT=15
GOTO FTS
GOTO @DGHNYT
Z SET Z=$EXTRACT(X,1,12)
SET Z=$$FMTE^XLFDT(Z,"5F")
SET Z=$TRANSLATE(Z," ","0")
SET Z=$TRANSLATE(Z,":")
QUIT
1 ; ADM,XFR,DIS ENTERED
+1 DO Z
SET ^DGS(43.5,H,0)=W_"^"_DGHNYT_"^^"_Z_"^"_DFN_"^"_DGADTM_"^"_DUZ_U_$PIECE(X,".")
SET ^DGS(43.5,"AGL",$PIECE(X,"."),H)=""
KILL DGIDX,DGHNYT
QUIT
2 ; ADM,XFR,DIS,FACILITY TS DELETED
+1 ; gets date/time of mvt
NEW X
SET X=+^DGPM(DA,0)
+2 DO Z
SET ^DGS(43.5,H,0)=W_"^"_DGHNYT_"^"_Z_"^^"_DFN_"^"_DGADTM_"^"_DUZ_U_$PIECE(X,".")_$SELECT(DGHNYT=5:U_X,1:"")
SET ^DGS(43.5,"AGL",$PIECE(X,"."),H)=""
KILL DGHNYT
QUIT
3 ; ADM,XFR,DIS DATE EDITED
+1 DO Z
DO NUM
SET DGED=$SELECT(DGED&(DGED<X):DGED,1:X)\1
SET ^(0)=W_"^"_DGHNYT_"^"_$PIECE(^DGS(43.5,H,0),"^",3)_"^"_Z_"^"_DFN_"^"_DGADTM_"^"_DUZ_U_DGED
SET ^DGS(43.5,"AGL",DGED,H)=""
KILL DGIDX,DGED,DGHNYT
QUIT
10 ; ADM WARD EDITED
+1 SET ^DGS(43.5,H,0)=W_"^10^"_$SELECT($DATA(DGOWD):DGOWD,1:"")_"^"_$SELECT($DATA(^DIC(42,+X,0)):$PIECE(^(0),"^",1),1:X)_"^"_DFN_"^"_DGADTM_"^"_DUZ_U_$PIECE(DGADTM,".")
SET ^DGS(43.5,"AGL",$PIECE(DGADTM,"."),H)=""
KILL DGOWD,DGIDX,DGHNYT
QUIT
11 ; MAS TYPE EDITED
+1 SET L=+^DGPM(DA,0)
SET ^DGS(43.5,H,0)=W_"^11^"_$SELECT($DATA(DGOTY):DGOTY,1:"")_"^"_$SELECT($DATA(^DG(405.2,+X,0)):$PIECE(^(0),"^",1),1:X)_"^"_DFN_"^"_DGADTM_"^"_DUZ_U_$PIECE(L,".")_U_L
SET ^DGS(43.5,"AGL",$PIECE(L,"."),H)=""
KILL DGOTY,DGIDX,DGHNYT
QUIT
12 ; XFR WARD EDITED
+1 SET L=+^DGPM(DA,0)
SET ^DGS(43.5,H,0)=W_"^12^"_$SELECT($DATA(DGOWD):DGOWD,1:"")_"^"_$SELECT($DATA(^DIC(42,+X,0)):$PIECE(^(0),"^",1),1:X)_"^"_DFN_"^"_DGADTM_"^"_DUZ_U_$PIECE(L,".")_U_L
SET ^DGS(43.5,"AGL",$PIECE(L,"."),H)=""
KILL DGOWD,DGIDX,DGHNYT
QUIT
+2 QUIT
FTS ; FACILITY TS
+1 ; 13 = ENTERED
+2 ; 14 = DELETED
+3 ; 15 = FACILITY TS DATE EDITED
+4 ;S IVD=$O(^DGPM("ATS",DFN,+$P(^DGPM(DA,0),"^",14),9999999.9999999-$P(^DGPM(DA,0),U))) S:IVD DGTS=$O(^DGPM("ATS",DFN,+$P(^DGPM(DA,0),"^",14),IVD,0)) S:DGTS DGOTS=$S($D(^DIC(45.7,+DGTS,0)):$P(^(0),U),1:"") Q:DGTS=X
+5 IF DGHNYT=15
DO Z
+6 SET L=+^DGPM(DA,0)
SET ^DGS(43.5,H,0)=W_"^"_DGHNYT_"^"_$SELECT(DGHNYT=15:$PIECE(^DGS(43.5,H,0),"^",3),$DATA(DGOTS):DGOTS,1:"")_"^"_$SELECT(DGHNYT=15:"",$DATA(^DIC(45.7,+X,0)):$PIECE(^(0),"^",1),1:X)_"^"_DFN_"^"_DGADTM_"^"_DUZ_U_$PIECE(L,".")_U_L
+7 ; sets flag in G&L Corrections file
SET ^DGS(43.5,"AGL",$PIECE(L,"."),H)=""
KILL KILL DGOTS,DGIDX,DGHNYT,DGTS,IVD
QUIT
+1 QUIT
NUM SET DGX=X
SET %DT=""
SET X=$PIECE($PIECE(^DGS(43.5,H,0),U,3),"@",1)
DO ^%DT
SET DGED=$PIECE(+Y,".")
SET X=DGX
KILL DGX
QUIT
+1 ;
