- 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 ;---------------------------------------------------------------------
