APCLVDR.m

APCLVDR ; IHS/CMI/LAB - driver for visit record generation ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 ;

 ;

VREC(APCLVIEN,APCLRTYP) ;PEP - called to send back a visit record as

 ;apcdfv=visit ien

 ;apcdrtyp=type of record in output definition file

 NEW APCLREC,APCLX,APCL

 S APCLREC=""

 I '$G(APCLVIEN) Q APCLREC

 I '$D(^AUPNVSIT(APCLVIEN)) Q APCLREC

 I $P(^AUPNVSIT(APCLVIEN,0),U,11) Q APCLREC

 I '$D(^AUPNVPOV("AD",APCLVIEN)) Q APCLREC

 I '$D(^AUPNVPRV("AD",APCLVIEN)) Q APCLREC

 S APCLRTYP("IEN")=$O(^APCLRECD("B",APCLRTYP,0))

 I 'APCLRTYP("IEN") Q APCLREC

 X:$G(^APCLRECD(APCLRTYP("IEN"),12))]"" ^APCLRECD(APCLRTYP("IEN"),12)

PROC ;

 S APCLX=0

 F  S APCLX=$O(^APCLRECD(APCLRTYP("IEN"),11,"AC",APCLX)) Q:APCLX'=+APCLX!(APCLREC=-1)  S APCL=$O(^APCLRECD(APCLRTYP("IEN"),11,"AC",APCLX,0))  D

 .S X="" X:$D(^APCLRECD(APCLRTYP("IEN"),11,APCL,11)) ^APCLRECD(APCLRTYP("IEN"),11,APCL,11)

 .I X["-1" S APCLREC=-1 Q

 .I X="",$P(^APCLRECD(APCLRTYP("IEN"),11,APCL,0),U,5) S APCLREC=-1 Q

 .;I X'[-1 S APCLREC=APCLREC_X

 .I X'[-1 S $E(APCLREC,$P(^APCLRECD(APCLRTYP("IEN"),11,APCL,0),U,2))=X

 ;S $E(APCLREC)=$P(^APCLRECD(APCLRTYP("IEN"),0),U,2)

 K APCLV0

 Q APCLREC

PREC(DFN,APCLRTYP) ;EP -create a patient record

 NEW APCLREC,APCLX,APCL

 S APCLREC=""

 I '$G(DFN) Q APCLREC

 I '$D(^DPT(DFN)) Q APCLREC

 S APCLRTYP("IEN")=$O(^APCLRECD("B",APCLRTYP,0))

 I 'APCLRTYP("IEN") Q APCLREC

 X:$G(^APCLRECD(APCLRTYP("IEN"),12))]"" ^APCLRECD(APCLRTYP("IEN"),12)

PPROC ;

 S APCLX=0

 F  S APCLX=$O(^APCLRECD(APCLRTYP("IEN"),11,"AC",APCLX)) Q:APCLX'=+APCLX!(APCLREC=-1)  S APCL=$O(^APCLRECD(APCLRTYP("IEN"),11,"AC",APCLX,0))  D

 .S X="" X:$D(^APCLRECD(APCLRTYP("IEN"),11,APCL,11)) ^APCLRECD(APCLRTYP("IEN"),11,APCL,11)

 .I X["-1" S APCLREC=-1 Q

 .I X="",$P(^APCLRECD(APCLRTYP("IEN"),11,APCL,0),U,5) S APCLREC=-1 Q

 .;I X'[-1 S APCLREC=APCLREC_X

 .I X'[-1 S $E(APCLREC,$P(^APCLRECD(APCLRTYP("IEN"),11,APCL,0),U,2))=X

 ;S $E(APCLREC)=$P(^APCLRECD(APCLRTYP("IEN"),0),U,2)

 Q APCLREC

APCLVDR   ; IHS/CMI/LAB - driver for visit record generation ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ;

 +3       ;

VREC(APCLVIEN,APCLRTYP) ;PEP - called to send back a visit record as

 +1       ;apcdfv=visit ien

 +2       ;apcdrtyp=type of record in output definition file

 +3        NEW APCLREC,APCLX,APCL

 +4        SET APCLREC=""

 +5        IF '$GET(APCLVIEN)

               QUIT APCLREC

 +6        IF '$DATA(^AUPNVSIT(APCLVIEN))

               QUIT APCLREC

 +7        IF $PIECE(^AUPNVSIT(APCLVIEN,0),U,11)

               QUIT APCLREC

 +8        IF '$DATA(^AUPNVPOV("AD",APCLVIEN))

               QUIT APCLREC

 +9        IF '$DATA(^AUPNVPRV("AD",APCLVIEN))

               QUIT APCLREC

 +10       SET APCLRTYP("IEN")=$ORDER(^APCLRECD("B",APCLRTYP,0))

 +11       IF 'APCLRTYP("IEN")

               QUIT APCLREC

 +12       IF $GET(^APCLRECD(APCLRTYP("IEN"),12))]""

               XECUTE ^APCLRECD(APCLRTYP("IEN"),12)

PROC      ;

 +1        SET APCLX=0

 +2        FOR 

               SET APCLX=$ORDER(^APCLRECD(APCLRTYP("IEN"),11,"AC",APCLX))

               IF APCLX'=+APCLX!(APCLREC=-1)

                   QUIT 

               SET APCL=$ORDER(^APCLRECD(APCLRTYP("IEN"),11,"AC",APCLX,0))

               Begin DoDot:1

 +3                SET X=""

                   IF $DATA(^APCLRECD(APCLRTYP("IEN"),11,APCL,11))

                       XECUTE ^APCLRECD(APCLRTYP("IEN"),11,APCL,11)

 +4                IF X["-1"

                       SET APCLREC=-1

                       QUIT 

 +5                IF X=""

                       IF $PIECE(^APCLRECD(APCLRTYP("IEN"),11,APCL,0),U,5)

                           SET APCLREC=-1

                           QUIT 

 +6       ;I X'[-1 S APCLREC=APCLREC_X

 +7                IF X'[-1

                       SET $EXTRACT(APCLREC,$PIECE(^APCLRECD(APCLRTYP("IEN"),11,APCL,0),U,2))=X

               End DoDot:1

 +8       ;S $E(APCLREC)=$P(^APCLRECD(APCLRTYP("IEN"),0),U,2)

 +9        KILL APCLV0

 +10       QUIT APCLREC

PREC(DFN,APCLRTYP) ;EP -create a patient record

 +1        NEW APCLREC,APCLX,APCL

 +2        SET APCLREC=""

 +3        IF '$GET(DFN)

               QUIT APCLREC

 +4        IF '$DATA(^DPT(DFN))

               QUIT APCLREC

 +5        SET APCLRTYP("IEN")=$ORDER(^APCLRECD("B",APCLRTYP,0))

 +6        IF 'APCLRTYP("IEN")

               QUIT APCLREC

 +7        IF $GET(^APCLRECD(APCLRTYP("IEN"),12))]""

               XECUTE ^APCLRECD(APCLRTYP("IEN"),12)

PPROC     ;

 +1        SET APCLX=0

 +2        FOR 

               SET APCLX=$ORDER(^APCLRECD(APCLRTYP("IEN"),11,"AC",APCLX))

               IF APCLX'=+APCLX!(APCLREC=-1)

                   QUIT 

               SET APCL=$ORDER(^APCLRECD(APCLRTYP("IEN"),11,"AC",APCLX,0))

               Begin DoDot:1

 +3                SET X=""

                   IF $DATA(^APCLRECD(APCLRTYP("IEN"),11,APCL,11))

                       XECUTE ^APCLRECD(APCLRTYP("IEN"),11,APCL,11)

 +4                IF X["-1"

                       SET APCLREC=-1

                       QUIT 

 +5                IF X=""

                       IF $PIECE(^APCLRECD(APCLRTYP("IEN"),11,APCL,0),U,5)

                           SET APCLREC=-1

                           QUIT 

 +6       ;I X'[-1 S APCLREC=APCLREC_X

 +7                IF X'[-1

                       SET $EXTRACT(APCLREC,$PIECE(^APCLRECD(APCLRTYP("IEN"),11,APCL,0),U,2))=X

               End DoDot:1

 +8       ;S $E(APCLREC)=$P(^APCLRECD(APCLRTYP("IEN"),0),U,2)

 +9        QUIT APCLREC