- AGTX3 ; IHS/ASDS/EFG - EXPORT REG DATA CONT'D ;
- ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
- ;
- DISP ;>Set RG2s,RG4s and RG5s
- I $P(^AUPNPAT(DFN,0),U,23) S $P(AGTEMP(2),U,31)=$P($G(^AUTTSSN($P(^AUPNPAT(DFN,0),U,23),0)),U,1)
- I $P(^AUPNPAT(DFN,0),U,3) S $P(AGTEMP(2),U,34)=$P(^(0),U,3)+17000000
- I $G(AGTXALL) S T(2)=$P(AGTEMP(2),U,1)_U_U_$P(AGTEMP(2),U,2,999) D SET^AGTXALL(2) KILL T(2) I 1
- E S AGROUT=AGROUT+1,AGTEMP(2)=$P(AGTEMP(2),U,1)_U_$$UID^AGTXID(DFN)_U_$P(AGTEMP(2),U,2,999),$P(AGTEMP(2),U,35)=$P(AGTEMP(2),U,35),^AGTXDATA(AGROUT)=AGTEMP(2),AG("TOT")=AG("TOT")+1
- F I=7,11,15,19 I $P(AGTEMP(2),U,I)="Y" D T5
- K AGTEMP,AGFLG
- S AG("HRN")=0,AGNAME=$P(^DPT(AGRCT,0),U)
- D NAMECVT^AGTX1
- HRN ;>Set RG4 HRNs
- S AGZSITE=AG("SITE"),AGRSITE=AG("SITE"),DFN=AGRCT
- D ^AGTXRHRN
- S AG("SITE")=AGRSITE
- I '$G(AGRHRN) K AGRSITE D ^AGTXRHRN S AG("SITE")=AGRSITE K AGRSITE,AGRHRN
- ;loop through other Site:HRN set RG4s
- S AGRSITE=0
- F S AGRSITE=$O(^AUPNPAT(AGRCT,41,AGRSITE)) Q:AGRSITE'>0 I AG("SITE")'=AGRSITE D HRN^AGTXRHRN I $G(AGRHRN) D
- . Q:'$P($G(^AUTTLOC(AGRSITE,0)),U,4) Q:'$G(AG("SITE"))
- . S AGTEMP(4)="RG4"_U_$P(^AUTTLOC(AG("SITE"),0),U,10)_U_$E(AGLN,1)_U_$E(AGFN,1)_U_$P(^DPT(AGRCT,0),U,2)_U_$P(^AUPNPAT(AGRCT,41,AG("SITE"),0),U,2)
- . S AGTEMP(4)=AGTEMP(4)_U_$P($G(^AGFAC(AGRSITE,0)),U,21)_U_$P(^AUTTLOC(AGRSITE,0),U,10)_U_AGRHRN
- . I $G(AGTXALL) S T(4)=$P(AGTEMP(4),U,1)_U_U_$P(AGTEMP(4),U,2,999) D SET^AGTXALL(4) KILL T(4) Q
- . S AGROUT=AGROUT+1,AGTEMP(4)=$P(AGTEMP(4),U,1)_U_$$UID^AGTXID(AGRCT)_U_$P(AGTEMP(4),U,2,999),$P(AGTEMP(4),U,10)=$P(AGTEMP(4),U,10),^AGTXDATA(AGROUT)=AGTEMP(4),AG("TOT")=AG("TOT")+1
- ENDHRN ;
- S AG("SITE")=AGZSITE
- K AGTEMP,AGRSITE,AGRHRN,AGZSITE
- Q:$G(AGTXALL) S AGID=$$UID^AGTXID(DFN) D RG8^AGTXALL
- END ;
- G S2AAA^AGTX1
- T5 ;>Set Coverages
- S $P(AGTEMP(5),U,2,6)=$P(AGTEMP(2),U,I+1)_U_$P(AGTEMP(2),U,I+2)_U_$S(I=7:1,I=11:2,I=15:3,1:4)_U_$P(AGTEMP(1),U,9)_U_$P(AGTEMP(2),U,I+3)
- I $G(AGTXALL) S T(5)=$P(AGTEMP(5),U,1)_U_U_$P(AGTEMP(5),U,2,999) D SET^AGTXALL(5) KILL T(5) Q
- S AGROUT=AGROUT+1,AGTEMP(5)=$P(AGTEMP(5),U,1)_U_$$UID^AGTXID(DFN)_U_$P(AGTEMP(5),U,2,999),$P(AGTEMP(5),U,20)=$P(^AUTTLOC(AGTXSITE,0),U,10),^AGTXDATA(AGROUT)=AGTEMP(5),AG("TOT")=AG("TOT")+1
- W:AGOUTFLG !,AGTEMP(5)
- I 'AGOUTFLG,AGROUT#10=0,'$G(AGTXALL) X XY W AGROUT
- S AGTEMP(5)=$P(AGTEMP(5),U,1)_U_$P(AGTEMP(5),U,3,999)
- Q
- AGTX3 ; IHS/ASDS/EFG - EXPORT REG DATA CONT'D ;
- +1 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
- +2 ;
- DISP ;>Set RG2s,RG4s and RG5s
- +1 IF $PIECE(^AUPNPAT(DFN,0),U,23)
- SET $PIECE(AGTEMP(2),U,31)=$PIECE($GET(^AUTTSSN($PIECE(^AUPNPAT(DFN,0),U,23),0)),U,1)
- +2 IF $PIECE(^AUPNPAT(DFN,0),U,3)
- SET $PIECE(AGTEMP(2),U,34)=$PIECE(^(0),U,3)+17000000
- +3 IF $GET(AGTXALL)
- SET T(2)=$PIECE(AGTEMP(2),U,1)_U_U_$PIECE(AGTEMP(2),U,2,999)
- DO SET^AGTXALL(2)
- KILL T(2)
- IF 1
- +4 IF '$TEST
- SET AGROUT=AGROUT+1
- SET AGTEMP(2)=$PIECE(AGTEMP(2),U,1)_U_$$UID^AGTXID(DFN)_U_$PIECE(AGTEMP(2),U,2,999)
- SET $PIECE(AGTEMP(2),U,35)=$PIECE(AGTEMP(2),U,35)
- SET ^AGTXDATA(AGROUT)=AGTEMP(2)
- SET AG("TOT")=AG("TOT")+1
- +5 FOR I=7,11,15,19
- IF $PIECE(AGTEMP(2),U,I)="Y"
- DO T5
- +6 KILL AGTEMP,AGFLG
- +7 SET AG("HRN")=0
- SET AGNAME=$PIECE(^DPT(AGRCT,0),U)
- +8 DO NAMECVT^AGTX1
- HRN ;>Set RG4 HRNs
- +1 SET AGZSITE=AG("SITE")
- SET AGRSITE=AG("SITE")
- SET DFN=AGRCT
- +2 DO ^AGTXRHRN
- +3 SET AG("SITE")=AGRSITE
- +4 IF '$GET(AGRHRN)
- KILL AGRSITE
- DO ^AGTXRHRN
- SET AG("SITE")=AGRSITE
- KILL AGRSITE,AGRHRN
- +5 ;loop through other Site:HRN set RG4s
- +6 SET AGRSITE=0
- +7 FOR
- SET AGRSITE=$ORDER(^AUPNPAT(AGRCT,41,AGRSITE))
- IF AGRSITE'>0
- QUIT
- IF AG("SITE")'=AGRSITE
- DO HRN^AGTXRHRN
- IF $GET(AGRHRN)
- Begin DoDot:1
- +8 IF '$PIECE($GET(^AUTTLOC(AGRSITE,0)),U,4)
- QUIT
- IF '$GET(AG("SITE"))
- QUIT
- +9 SET AGTEMP(4)="RG4"_U_$PIECE(^AUTTLOC(AG("SITE"),0),U,10)_U_$EXTRACT(AGLN,1)_U_$EXTRACT(AGFN,1)_U_$PIECE(^DPT(AGRCT,0),U,2)_U_$PIECE(^AUPNPAT(AGRCT,41,AG("SITE"),0),U,2)
- +10 SET AGTEMP(4)=AGTEMP(4)_U_$PIECE($GET(^AGFAC(AGRSITE,0)),U,21)_U_$PIECE(^AUTTLOC(AGRSITE,0),U,10)_U_AGRHRN
- +11 IF $GET(AGTXALL)
- SET T(4)=$PIECE(AGTEMP(4),U,1)_U_U_$PIECE(AGTEMP(4),U,2,999)
- DO SET^AGTXALL(4)
- KILL T(4)
- QUIT
- +12 SET AGROUT=AGROUT+1
- SET AGTEMP(4)=$PIECE(AGTEMP(4),U,1)_U_$$UID^AGTXID(AGRCT)_U_$PIECE(AGTEMP(4),U,2,999)
- SET $PIECE(AGTEMP(4),U,10)=$PIECE(AGTEMP(4),U,10)
- SET ^AGTXDATA(AGROUT)=AGTEMP(4)
- SET AG("TOT")=AG("TOT")+1
- End DoDot:1
- ENDHRN ;
- +1 SET AG("SITE")=AGZSITE
- +2 KILL AGTEMP,AGRSITE,AGRHRN,AGZSITE
- +3 IF $GET(AGTXALL)
- QUIT
- SET AGID=$$UID^AGTXID(DFN)
- DO RG8^AGTXALL
- END ;
- +1 GOTO S2AAA^AGTX1
- T5 ;>Set Coverages
- +1 SET $PIECE(AGTEMP(5),U,2,6)=$PIECE(AGTEMP(2),U,I+1)_U_$PIECE(AGTEMP(2),U,I+2)_U_$SELECT(I=7:1,I=11:2,I=15:3,1:4)_U_$PIECE(AGTEMP(1),U,9)_U_$PIECE(AGTEMP(2),U,I+3)
- +2 IF $GET(AGTXALL)
- SET T(5)=$PIECE(AGTEMP(5),U,1)_U_U_$PIECE(AGTEMP(5),U,2,999)
- DO SET^AGTXALL(5)
- KILL T(5)
- QUIT
- +3 SET AGROUT=AGROUT+1
- SET AGTEMP(5)=$PIECE(AGTEMP(5),U,1)_U_$$UID^AGTXID(DFN)_U_$PIECE(AGTEMP(5),U,2,999)
- SET $PIECE(AGTEMP(5),U,20)=$PIECE(^AUTTLOC(AGTXSITE,0),U,10)
- SET ^AGTXDATA(AGROUT)=AGTEMP(5)
- SET AG("TOT")=AG("TOT")+1
- +4 IF AGOUTFLG
- WRITE !,AGTEMP(5)
- +5 IF 'AGOUTFLG
- IF AGROUT#10=0
- IF '$GET(AGTXALL)
- XECUTE XY
- WRITE AGROUT
- +6 SET AGTEMP(5)=$PIECE(AGTEMP(5),U,1)_U_$PIECE(AGTEMP(5),U,3,999)
- +7 QUIT
