APCPHTX.m

APCPHTX ; IHS/TUCSON/LAB - create direct inpatient tx AUGUST 14, 1992 ; [ 09/16/02 12:16 PM ]

 ;;2.0;IHS PCC DATA EXTRACTION SYSTEM;**1,6**;APR 03, 1998

 ;IHS/CMI/LAB - XTMP and no longer send INPT txs

SETTX ;

 Q  ;IHS/CMI/LAB - no longer send inpt recs

 S APCP("INPT")=APCP("INPT")+1,APCP("COUNT")=APCP("COUNT")+1

 S APCPV("TX GENERATED")=1,^XTMP("APCP"_$S(APCPO("RUN")="NEW":"DR",APCPO("RUN")="REDO":"REDO",1:"DR"),"MAIN TX",APCP("V DFN"))=APCP("MAIN TX DATE") ;LAB VERSION 1.4

 NEW Y S Y=0 F  S Y=$O(^APCPREC(2,11,"B",Y)) Q:Y'=+Y  D

 .S X=""

 .Q:'$D(^APCPREC(2,11,Y,1))

 .X ^APCPREC(2,11,Y,1)

 .S $P(APCPV("TX"),U,Y)=X

 S ^BAPCDATA(APCP("COUNT"))="IP1"_U_APCPV("TX")

 Q

APCPHTX   ; IHS/TUCSON/LAB - create direct inpatient tx AUGUST 14, 1992 ; [ 09/16/02 12:16 PM ]

 +1       ;;2.0;IHS PCC DATA EXTRACTION SYSTEM;**1,6**;APR 03, 1998

 +2       ;IHS/CMI/LAB - XTMP and no longer send INPT txs

SETTX     ;

 +1       ;IHS/CMI/LAB - no longer send inpt recs

           QUIT 

 +2        SET APCP("INPT")=APCP("INPT")+1

           SET APCP("COUNT")=APCP("COUNT")+1

 +3       ;LAB VERSION 1.4

           SET APCPV("TX GENERATED")=1

           SET ^XTMP("APCP"_$SELECT(APCPO("RUN")="NEW":"DR",APCPO("RUN")="REDO":"REDO",1:"DR"),"MAIN TX",APCP("V DFN"))=APCP("MAIN TX DATE")

 +4        NEW Y

           SET Y=0

           FOR 

               SET Y=$ORDER(^APCPREC(2,11,"B",Y))

               IF Y'=+Y

                   QUIT 

               Begin DoDot:1

 +5                SET X=""

 +6                IF '$DATA(^APCPREC(2,11,Y,1))

                       QUIT 

 +7                XECUTE ^APCPREC(2,11,Y,1)

 +8                SET $PIECE(APCPV("TX"),U,Y)=X

               End DoDot:1

 +9        SET ^BAPCDATA(APCP("COUNT"))="IP1"_U_APCPV("TX")

 +10       QUIT