- DGPMGLC ;ALB/XAK,JDS,MJK,LM - G&L CORRECTIONS ;10 AUG 84 15:19
- ;;5.3;Registration;**36,59,170,1015**;Aug 13, 1993;Build 21
- ;
- ;
- 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
- ;
- DGPMGLC ;ALB/XAK,JDS,MJK,LM - G&L CORRECTIONS ;10 AUG 84 15:19
- +1 ;;5.3;Registration;**36,59,170,1015**;Aug 13, 1993;Build 21
- +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 ;
