AZHZCLAG ;DSD/PDW - SET AGPATCH NODES FROM EDITS AND PCC/APC ; AUGUST 14, 1992
;;1.0;AZHZ;;AUG 14, 1992
;
S ;
S:'$D(DUOUT) DUOUT=0 S:'$D(DFOUT) DFOUT=0
Q:(DFOUT!DUOUT)
I '$D(^AZHZTEMP) W *7,!,"< Compiled Edits Global not Present >",! Q
I ^AZHZTEMP'="",^AZHZTEMP'="AGPATCH" W *7,!,"< Sorry ",^AZHZTEMP," needs to be completed first >",!,*7 G EXIT ;-----
I '$D(^AZHZTEMP("A",3)) W !,*7,"< Perform Edits must be completed first >",! G EXIT^AZHZCL ;----
I $D(^AZHZTEMP("A",4,"TRANS COMPLETED")) W !,*7,"<TRANSMISSION sets have already been completed >",! G EXIT ;-----
CON S AZHZHDR="Setting AGPATCH nodes",AZHZRTN="DQTRAN^AZHZCLAG"
D INIT Q:(DFOUT!DUOUT) ;-----
DQTRAN ;ENTRY POINT FOR TASKING
S ^AZHZTEMP="AGPATCH"
W !,"Listed here are Patients that do not have a HRN at a Facility",!,"compatible with this Site's Area-Service Unit Number",!
S AZHZSITE=+^AUTTSITE(1,0),AZHZASN=$E($P(^AUTTLOC(AZHZSITE,0),U,10),1,4) D DT^DICRW
; set AGPATCH from the Compiled Edits Global
W !,"Scanning the Compiled Edit Global",!,"EACH DOT = 100 of ",^AZHZTEMP(0),!
S AZHZCC=0,AZHZPN="" F AZHZXC=0:1 W:'(AZHZXC#100) "." S AZHZPN=$O(^AZHZTEMP("B",AZHZPN)) Q:(DUOUT!DFOUT) Q:AZHZPN="" S DFN=0 F S DFN=$O(^AZHZTEMP("B",AZHZPN,DFN)) Q:(DFOUT!DUOUT) Q:'DFN D SET
W !,?10,AZHZCC," nodes set from the Compiled Edit Global" W ! D ^%T
I 'DFOUT,'DUOUT S ^AZHZTEMP="",^AZHZTEMP("A",4,"TRANS COMPLETED")=""
D EXIT^AZHZCL
Q ;-----
;---------------------------------------------------------------------
SET ;set AGPATCH with Patient site that matches Area/Service number
D ACTIVE Q:'AZHZAAP ; do not send inactive patients
Q:(DFOUT!DUOUT) Q:$D(^AZHZTEMP("AG",DFN)) Q:$D(^AGPATCH(DT,AZHZSITE,DFN))
TEST I '$D(^AZHZTEMP(DFN,"V")),$O(^AZHZTEMP(DFN,"I",0))=1109,$O(^AZHZTEMP(DFN,"I",1109))="" Q ;do not set AGPATCH if only tribe quantum was edited
I $D(^AUPNPAT(DFN,41,AZHZSITE,0)) S ^AGPATCH(DT,AZHZSITE,DFN)="",AZHZCC=AZHZCC+1 Q ;-----
S AZHZS=0 F S AZHZS=$O(^AUPNPAT(DFN,41,AZHZS)) Q:(DFOUT!DUOUT) Q:'AZHZS S AZHZSASN=$E($P(^AUTTLOC(AZHZS,0),U,10),1,4) Q:(DFOUT!DUOUT) Q:AZHZSASN=AZHZASN ;matched Area Service Number
T I AZHZS Q:$D(^AGPATCH(DT,AZHZS,DFN)) S ^AGPATCH(DT,AZHZS,DFN)="",AZHZCC=AZHZCC+1 Q ;----
E U IO D AZHZPG W !,DFN,?10,$P(^DPT(DFN,0),U)
E Q ;-----
;---------------------------------------------------------------------
ACTIVE ;ENTRY POINT for testing to see if patient is active
;SETS AZHZAAP=1 if patient has active HRN records
S AZHZAAP=0 I $D(^AUPNPAT(DFN,41,0)),+$O(^(0)) S AZHZAS=0 F S AZHZAS=$O(^AUPNPAT(DFN,41,AZHZAS)) Q:'+AZHZAS S:$P(^(AZHZAS,0),U,3)="" AZHZAAP=1
EACT K AZHZAS Q ;----
;---------------------------------------------------------------------
AZHZPG ; page controller
S:'$D(DUOUT) DUOUT=0 S:'$D(DFOUT) DFOUT=0
Q:($Y<(IOSL-4))!(DUOUT!DFOUT) S:'$D(AZHZPG) AZHZPG=0 S AZHZPG=AZHZPG+1 I $E(IOST)="C" R !,"^ to quit ",AZHZX:DTIME I $E(AZHZX)="^" S DUOUT=1,DFOUT=1 Q
AZHZHDR ; Header controller
W !,@IOF Q:'$D(AZHZHDR) S:'$D(AZHZLINE) $P(AZHZLINE,"-",IOM-2)="" S:'$D(AZHZPG) AZHZPG=1 I '$D(AZHZDT) D DT^DICRW S Y=DT D DD^%DT S AZHZDT=Y
U IO W ?(IOM-20-$L(AZHZHDR)/2),AZHZHDR,?(IOM-25),AZHZDT,?(IOM-10),"PAGE: ",AZHZPG,!,AZHZLINE,!
EAZHZPG Q ;-----
;---------------------------------------------------------------------
INIT D INIT^AZHZCL Q ;-----
;---------------------------------------------------------------------
EXIT G EXIT^AZHZCL1 ;-----
;---------------------------------------------------------------------
AZHZCLAG ;DSD/PDW - SET AGPATCH NODES FROM EDITS AND PCC/APC ; AUGUST 14, 1992
+1 ;;1.0;AZHZ;;AUG 14, 1992
+2 ;
S ;
+1 IF '$DATA(DUOUT)
SET DUOUT=0
IF '$DATA(DFOUT)
SET DFOUT=0
+2 IF (DFOUT!DUOUT)
QUIT
+3 IF '$DATA(^AZHZTEMP)
WRITE *7,!,"< Compiled Edits Global not Present >",!
QUIT
+4 ;-----
IF ^AZHZTEMP'=""
IF ^AZHZTEMP'="AGPATCH"
WRITE *7,!,"< Sorry ",^AZHZTEMP," needs to be completed first >",!,*7
GOTO EXIT
+5 ;----
IF '$DATA(^AZHZTEMP("A",3))
WRITE !,*7,"< Perform Edits must be completed first >",!
GOTO EXIT^AZHZCL
+6 ;-----
IF $DATA(^AZHZTEMP("A",4,"TRANS COMPLETED"))
WRITE !,*7,"<TRANSMISSION sets have already been completed >",!
GOTO EXIT
CON SET AZHZHDR="Setting AGPATCH nodes"
SET AZHZRTN="DQTRAN^AZHZCLAG"
+1 ;-----
DO INIT
IF (DFOUT!DUOUT)
QUIT
DQTRAN ;ENTRY POINT FOR TASKING
+1 SET ^AZHZTEMP="AGPATCH"
+2 WRITE !,"Listed here are Patients that do not have a HRN at a Facility",!,"compatible with this Site's Area-Service Unit Number",!
+3 SET AZHZSITE=+^AUTTSITE(1,0)
SET AZHZASN=$EXTRACT($PIECE(^AUTTLOC(AZHZSITE,0),U,10),1,4)
DO DT^DICRW
+4 ; set AGPATCH from the Compiled Edits Global
+5 WRITE !,"Scanning the Compiled Edit Global",!,"EACH DOT = 100 of ",^AZHZTEMP(0),!
+6 SET AZHZCC=0
SET AZHZPN=""
FOR AZHZXC=0:1
IF '(AZHZXC#100)
WRITE "."
SET AZHZPN=$ORDER(^AZHZTEMP("B",AZHZPN))
IF (DUOUT!DFOUT)
QUIT
IF AZHZPN=""
QUIT
SET DFN=0
FOR
SET DFN=$ORDER(^AZHZTEMP("B",AZHZPN,DFN))
IF (DFOUT!DUOUT)
QUIT
IF 'DFN
QUIT
DO SET
+7 WRITE !,?10,AZHZCC," nodes set from the Compiled Edit Global"
WRITE !
DO ^%T
+8 IF 'DFOUT
IF 'DUOUT
SET ^AZHZTEMP=""
SET ^AZHZTEMP("A",4,"TRANS COMPLETED")=""
+9 DO EXIT^AZHZCL
+10 ;-----
QUIT
+11 ;---------------------------------------------------------------------
SET ;set AGPATCH with Patient site that matches Area/Service number
+1 ; do not send inactive patients
DO ACTIVE
IF 'AZHZAAP
QUIT
+2 IF (DFOUT!DUOUT)
QUIT
IF $DATA(^AZHZTEMP("AG",DFN))
QUIT
IF $DATA(^AGPATCH(DT,AZHZSITE,DFN))
QUIT
TEST ;do not set AGPATCH if only tribe quantum was edited
IF '$DATA(^AZHZTEMP(DFN,"V"))
IF $ORDER(^AZHZTEMP(DFN,"I",0))=1109
IF $ORDER(^AZHZTEMP(DFN,"I",1109))=""
QUIT
+1 ;-----
IF $DATA(^AUPNPAT(DFN,41,AZHZSITE,0))
SET ^AGPATCH(DT,AZHZSITE,DFN)=""
SET AZHZCC=AZHZCC+1
QUIT
+2 ;matched Area Service Number
SET AZHZS=0
FOR
SET AZHZS=$ORDER(^AUPNPAT(DFN,41,AZHZS))
IF (DFOUT!DUOUT)
QUIT
IF 'AZHZS
QUIT
SET AZHZSASN=$EXTRACT($PIECE(^AUTTLOC(AZHZS,0),U,10),1,4)
IF (DFOUT!DUOUT)
QUIT
IF AZHZSASN=AZHZASN
QUIT
T ;----
IF AZHZS
IF $DATA(^AGPATCH(DT,AZHZS,DFN))
QUIT
SET ^AGPATCH(DT,AZHZS,DFN)=""
SET AZHZCC=AZHZCC+1
QUIT
+1 IF '$TEST
USE IO
DO AZHZPG
WRITE !,DFN,?10,$PIECE(^DPT(DFN,0),U)
E ;-----
QUIT
+1 ;---------------------------------------------------------------------
ACTIVE ;ENTRY POINT for testing to see if patient is active
+1 ;SETS AZHZAAP=1 if patient has active HRN records
+2 SET AZHZAAP=0
IF $DATA(^AUPNPAT(DFN,41,0))
IF +$ORDER(^(0))
SET AZHZAS=0
FOR
SET AZHZAS=$ORDER(^AUPNPAT(DFN,41,AZHZAS))
IF '+AZHZAS
QUIT
IF $PIECE(^(AZHZAS,0),U,3)=""
SET AZHZAAP=1
EACT ;----
KILL AZHZAS
QUIT
+1 ;---------------------------------------------------------------------
AZHZPG ; page controller
+1 IF '$DATA(DUOUT)
SET DUOUT=0
IF '$DATA(DFOUT)
SET DFOUT=0
+2 IF ($Y<(IOSL-4))!(DUOUT!DFOUT)
QUIT
IF '$DATA(AZHZPG)
SET AZHZPG=0
SET AZHZPG=AZHZPG+1
IF $EXTRACT(IOST)="C"
READ !,"^ to quit ",AZHZX:DTIME
IF $EXTRACT(AZHZX)="^"
SET DUOUT=1
SET DFOUT=1
QUIT
AZHZHDR ; Header controller
+1 WRITE !,@IOF
IF '$DATA(AZHZHDR)
QUIT
IF '$DATA(AZHZLINE)
SET $PIECE(AZHZLINE,"-",IOM-2)=""
IF '$DATA(AZHZPG)
SET AZHZPG=1
IF '$DATA(AZHZDT)
DO DT^DICRW
SET Y=DT
DO DD^%DT
SET AZHZDT=Y
+2 USE IO
WRITE ?(IOM-20-$LENGTH(AZHZHDR)/2),AZHZHDR,?(IOM-25),AZHZDT,?(IOM-10),"PAGE: ",AZHZPG,!,AZHZLINE,!
EAZHZPG ;-----
QUIT
+1 ;---------------------------------------------------------------------
INIT ;-----
DO INIT^AZHZCL
QUIT
+1 ;---------------------------------------------------------------------
EXIT ;-----
GOTO EXIT^AZHZCL1
+1 ;---------------------------------------------------------------------
