- DGPTFREL ;ALB/JDS - DATA RELEASE ;1/25/05 12:22pm
- ;;5.3;Registration;**635,1015**;Aug 13, 1993;Build 21
- ;
- D LO^DGUTL
- ASK L ^DGP(45.83):3 I '$T W !,"Cannot release while transmitting" Q
- L W !! K DIC I '$D(DGRTY) S Y=1 D RTY^DGPTUTL
- S DIC("A")="Release "_$P(DGRTY0,U)_" Record: ",DIC="^DGP(45.84,",DIC(0)="EQMZA"
- S DIC("S")="I '$D(^DGP(45.83,""C"",+Y)),$D(^DGPT(+Y,0)),$P(^(0),U,11)="_DGRTY
- D ^DIC K DIC G Q:Y'>0 S (DA,DGPTIFN,PTF)=+Y
- ;
- EN ; -- entry point
- S DGREL=^DGP(45.84,DGPTIFN,0),DGPTF=^DGPT(DGPTIFN,0),DFN=+DGPTF,DGPT=^DPT(DFN,0),Y=$P(DGREL,U,2) D D^DGPTUTL
- REL ;
- W !!,"Release ",$P(DGRTY0,U)," record #",DGPTIFN," for:",!?5,$P(DGPT,U,1)," - ",$P(DGPT,U,9)," Closed ",Y S %=2 D YN^DICN
- I '% W !!,"Enter 'Y' if this is the ",$P(DGRTY0,U)," record you wish to release for transmission",!,"to Austin, 'N' or <RET> if not.",! G REL
- G Q:%'=1
- I '$D(^DGP(45.83,DT,0)) S (DINUM,X)=DT,DIC="^DGP(45.83,",DIC(0)="L" K DD,DO D FILE^DICN K DINUM,DIC I Y=-1 W !,*7,"Cannot continue without proper FileMan access. Please see your supervisor." G Q
- L +^DGPT(45,DGPTIFN):2
- I '$T W !,"Patient is being edited by another user" H 2 G Q
- I '($D(^DGP(45.83,DT,"P",0))#2) S ^DGP(45.83,DT,"P",0)="^45.831PA^0^0"
- I $P(^DGP(45.83,DT,0),U,2) S DA=DT,DIE="^DGP(45.83,",DR="1///@" D ^DIE K DIE
- ;S DA=DGPTIFN,DA(1)=DT,DR=".01///"_DGPTIFN,DP=45.831,DIE="^DGP(45.83,"_DT_",""P""," D ^DIE ; old code left for reference
- S (DINUM,X)=DGPTIFN,DIC(0)="L",DA(1)=DT,DIC="^DGP(45.83,"_DT_",""P""," D FILE^DICN K DINUM,DIC,DA
- S DA=DGPTIFN,DIE="^DGP(45.84,",DR="4////"_DT_";5////"_DUZ D ^DIE
- D MOB^DGPTFM2,ICDINFO^DGAPI(DFN,PTF),XREF^DGPTFM21
- S DR=".07////1"
- F DGZP=1:1 Q:'$D(DGZPRF(DGZP)) D
- .I '$P(DGZPRF(DGZP),U,7),$$DATA2PCE^DGAPI1(DFN,DGPTIFN,DGZP) D ERR:RES<-1,^DIE:RES>-2
- W !!,"****** ",$P(DGRTY0,U)," RECORD RELEASED ******",!
- L -^DGPT(45,DGPTIFN) D HANG^DGPTUTL
- I DGRTY=1 D ^A1B2MAIN
- I $D(DRGCAL)!$D(DGPTFLE) G CEN
- G ASK
- ;
- CEN ; -- does census also need to be released if releasing PTF in Load/Edit
- I $D(DGPTFLE),DGRTY=1,$D(DGCST),DGCST=1,$D(DGCI) W !!,*7,"Census Record #",DGCI," also needs to be 'released'." S DGPTIFN=DGCI,Y=2 D RTY^DGPTUTL G EN
- ;
- Q K DGRTY,DGRTY0,DGPTIFN,DGPTFLE,DGREL,DGPTF,DFN,DGPT,A,DIE,DIC,DA,Y,%,X,DR,DP
- D Q1^DGPTF Q
- ERR W @IOF
- F I=1:1 Q:'$D(^TMP("DGPAPI",$J,"DIERR",$J,1,"TEXT",I)) W !,^(I)
- W !,"Press return to continue." R X:DTIME Q
- ;
- DGPTFREL ;ALB/JDS - DATA RELEASE ;1/25/05 12:22pm
- +1 ;;5.3;Registration;**635,1015**;Aug 13, 1993;Build 21
- +2 ;
- +3 DO LO^DGUTL
- ASK LOCK ^DGP(45.83):3
- IF '$TEST
- WRITE !,"Cannot release while transmitting"
- QUIT
- +1 LOCK
- WRITE !!
- KILL DIC
- IF '$DATA(DGRTY)
- SET Y=1
- DO RTY^DGPTUTL
- +2 SET DIC("A")="Release "_$PIECE(DGRTY0,U)_" Record: "
- SET DIC="^DGP(45.84,"
- SET DIC(0)="EQMZA"
- +3 SET DIC("S")="I '$D(^DGP(45.83,""C"",+Y)),$D(^DGPT(+Y,0)),$P(^(0),U,11)="_DGRTY
- +4 DO ^DIC
- KILL DIC
- IF Y'>0
- GOTO Q
- SET (DA,DGPTIFN,PTF)=+Y
- +5 ;
- EN ; -- entry point
- +1 SET DGREL=^DGP(45.84,DGPTIFN,0)
- SET DGPTF=^DGPT(DGPTIFN,0)
- SET DFN=+DGPTF
- SET DGPT=^DPT(DFN,0)
- SET Y=$PIECE(DGREL,U,2)
- DO D^DGPTUTL
- REL ;
- +1 WRITE !!,"Release ",$PIECE(DGRTY0,U)," record #",DGPTIFN," for:",!?5,$PIECE(DGPT,U,1)," - ",$PIECE(DGPT,U,9)," Closed ",Y
- SET %=2
- DO YN^DICN
- +2 IF '%
- WRITE !!,"Enter 'Y' if this is the ",$PIECE(DGRTY0,U)," record you wish to release for transmission",!,"to Austin, 'N' or <RET> if not.",!
- GOTO REL
- +3 IF %'=1
- GOTO Q
- +4 IF '$DATA(^DGP(45.83,DT,0))
- SET (DINUM,X)=DT
- SET DIC="^DGP(45.83,"
- SET DIC(0)="L"
- KILL DD,DO
- DO FILE^DICN
- KILL DINUM,DIC
- IF Y=-1
- WRITE !,*7,"Cannot continue without proper FileMan access. Please see your supervisor."
- GOTO Q
- +5 LOCK +^DGPT(45,DGPTIFN):2
- +6 IF '$TEST
- WRITE !,"Patient is being edited by another user"
- HANG 2
- GOTO Q
- +7 IF '($DATA(^DGP(45.83,DT,"P",0))#2)
- SET ^DGP(45.83,DT,"P",0)="^45.831PA^0^0"
- +8 IF $PIECE(^DGP(45.83,DT,0),U,2)
- SET DA=DT
- SET DIE="^DGP(45.83,"
- SET DR="1///@"
- DO ^DIE
- KILL DIE
- +9 ;S DA=DGPTIFN,DA(1)=DT,DR=".01///"_DGPTIFN,DP=45.831,DIE="^DGP(45.83,"_DT_",""P""," D ^DIE ; old code left for reference
- +10 SET (DINUM,X)=DGPTIFN
- SET DIC(0)="L"
- SET DA(1)=DT
- SET DIC="^DGP(45.83,"_DT_",""P"","
- DO FILE^DICN
- KILL DINUM,DIC,DA
- +11 SET DA=DGPTIFN
- SET DIE="^DGP(45.84,"
- SET DR="4////"_DT_";5////"_DUZ
- DO ^DIE
- +12 DO MOB^DGPTFM2
- DO ICDINFO^DGAPI(DFN,PTF)
- DO XREF^DGPTFM21
- +13 SET DR=".07////1"
- +14 FOR DGZP=1:1
- IF '$DATA(DGZPRF(DGZP))
- QUIT
- Begin DoDot:1
- +15 IF '$PIECE(DGZPRF(DGZP),U,7)
- IF $$DATA2PCE^DGAPI1(DFN,DGPTIFN,DGZP)
- IF RES<-1
- DO ERR
- IF RES>-2
- DO ^DIE
- End DoDot:1
- +16 WRITE !!,"****** ",$PIECE(DGRTY0,U)," RECORD RELEASED ******",!
- +17 LOCK -^DGPT(45,DGPTIFN)
- DO HANG^DGPTUTL
- +18 IF DGRTY=1
- DO ^A1B2MAIN
- +19 IF $DATA(DRGCAL)!$DATA(DGPTFLE)
- GOTO CEN
- +20 GOTO ASK
- +21 ;
- CEN ; -- does census also need to be released if releasing PTF in Load/Edit
- +1 IF $DATA(DGPTFLE)
- IF DGRTY=1
- IF $DATA(DGCST)
- IF DGCST=1
- IF $DATA(DGCI)
- WRITE !!,*7,"Census Record #",DGCI," also needs to be 'released'."
- SET DGPTIFN=DGCI
- SET Y=2
- DO RTY^DGPTUTL
- GOTO EN
- +2 ;
- Q KILL DGRTY,DGRTY0,DGPTIFN,DGPTFLE,DGREL,DGPTF,DFN,DGPT,A,DIE,DIC,DA,Y,%,X,DR,DP
- +1 DO Q1^DGPTF
- QUIT
- ERR WRITE @IOF
- +1 FOR I=1:1
- IF '$DATA(^TMP("DGPAPI",$JOB,"DIERR",$JOB,1,"TEXT",I))
- QUIT
- WRITE !,^(I)
- +2 WRITE !,"Press return to continue."
- READ X:DTIME
- QUIT
- +3 ;
