source: FOIAVistA/trunk/r/OCCURRENCE_SCREEN-QAO/QAOSSFR0.m@ 1553

QAOSSFR0 ;HISC/DAD-OCCURRENCE SCREEN / MONITORING SYSTEM AUTO ENROLL SPECIAL FUNCTIONS ROUTINE ;6/29/93  09:31
 ;;3.0;Occurrence Screen;;09/14/1993
 K ^TMP("QAO",$J)
 S QAOSSCRN=+$O(^QA(741.1,"AM",QAMD0,0)) G:QAOSSCRN'>0 EXIT
 S QAOS740=$G(^QA(740,1,"OS"))
 F QAOSDFN=0:0 S QAOSDFN=$O(^UTILITY($J,"QAM FALL OUT",QAMD0,QAOSDFN)) Q:QAOSDFN'>0  F QAOSDATE=0:0 S QAOSDATE=$O(^UTILITY($J,"QAM FALL OUT",QAMD0,QAOSDFN,QAOSDATE)) Q:QAOSDATE'>0!(QAOSDATE\1'?7N)  D LOOP1
 F QAOSSCR=0:0 S QAOSSCR=$O(^QA(741.1,QAOSSCR)) Q:(QAOSSCR'>0)!(QAOSSCR'<200)  I $P($G(^QA(741.1,QAOSSCR,0)),"^",4)'>0 S QAOSTOT(QAOSSCR)=0
 F QAOSDT=QAMTODAY-.0000001:0 S QAOSDT=$O(^QA(741,"ARCD",QAOSDT)) Q:(QAOSDT'>0)!(QAOSDT>(QAMTODAY+.24))!(QAOSDT\1'?7N)  F QAOSS0=0:0 S QAOSS0=$O(^QA(741,"ARCD",QAOSDT,QAOSS0)) Q:QAOSS0'>0  D
 . S QAOSSCR=+$G(^QA(741,QAOSS0,"SCRN"))
 . Q:(QAOSSCR'>0)!(QAOSSCR'<200)  Q:$D(QAOSTOT(QAOSSCR))[0
 . S QAOSTOT(QAOSSCR)=QAOSTOT(QAOSSCR)+1
 . Q
 K DD,DIC,DINUM,DO S DIC="^QA(741.99,",DIC(0)="LMN",DLAYGO=741.99
 S X=QAMTODAY D ^DIC S QAO74199=+Y
 K DR S DIE="^QA(741.99,",DA=QAO74199,DR=""
 F QAOSSCR=0:0 S QAOSSCR=$O(QAOSTOT(QAOSSCR)) Q:QAOSSCR'>0  D
 . S QA=$P($T(@(10*QAOSSCR\1)),";;",2)
 . S DR=DR_$S(QA]"":$E(";",DR]"")_QA_"///"_QAOSTOT(QAOSSCR),1:"")
 . Q
 I DR]"" D ^DIE
 D PRINT^QAOSSFR1
EXIT ;
 K ^TMP("QAO",$J)
 K %DT,DA,DD,DFN,DIC,DIE,DINUM,DLAYGO,DO,DR,PAGE,QAO74199,QAOCOUNT
 K QAOSD0,QAOSDATA,QAOSDATE,QAOSDFN,QAOSDIAG,QAOSDT,QAOSDUP
 K QAOSMVDT,QAOSPAT,QAOSPID,QAOSQUIT,QAOSS0,QAOSSCR,QAOSSCRN
 K QAOSSERV,QAOSTOT,QAOSTXSP,QAOSWARD,QAUDIT,TODAY,UNDL,VA,X,Y
 K ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
 Q
 ;
LOOP1 ;
 S QAOSDFN(0)=$S($D(^DPT(QAOSDFN,0))#2:$P(^(0),"^"),1:QAOSDFN)
 S QAOSWARD=$G(^UTILITY($J,"QAM FALL OUT",QAMD0,QAOSDFN,QAOSDATE,"WARD"))
 S QAOSDIVN=$P($G(^DIC(42,+QAOSWARD,0)),"^",11)
 S QAOSDIVN=$S($D(^DG(40.8,+QAOSDIVN,0))#2:QAOSDIVN,1:"*")
 I $P(QAOSWARD,"^",2) S QAOSWARD=+$P(QAOSWARD,"^",2)
 E  S QAOSWARD=+$P($G(^DIC(42,+QAOSWARD,44)),"^")
 S X=$G(^SC(+QAOSWARD,0)),QAOSWARD=$S(X]"":QAOSWARD,1:"")
 S QAOSWARD=$S(QAOSWARD'>0:"","^C^W^"[("^"_$P(X,"^",3)_"^"):+QAOSWARD,1:"")
 S QAOSTXSP=$G(^UTILITY($J,"QAM FALL OUT",QAMD0,QAOSDFN,QAOSDATE,"TXSP"))
 S QAOSTXSP=$S(QAOSTXSP'>0:"",$D(^DIC(45.7,+QAOSTXSP,0))#2:+QAOSTXSP,1:"")
 S QAOSSERV=$P($G(^DIC(45.7,+QAOSTXSP,0)),"^",4)
 S QAOSSERV=$S(QAOSSERV'>0:"",$D(^DIC(49,+QAOSSERV,0))#2:+QAOSSERV,1:"")
 S QAOSDIAG=$G(^UTILITY($J,"QAM FALL OUT",QAMD0,QAOSDFN,QAOSDATE,"DIAG"))
 S QAOSMVDT=$G(^UTILITY($J,"QAM FALL OUT",QAMD0,QAOSDFN,QAOSDATE,"MVDT"))
 S QAOSAADM=$G(^UTILITY($J,"QAM FALL OUT",QAMD0,QAOSDFN,QAOSDATE,"AADM"))
 S QAOSAADM=$S(QAOSDATE\1'<($P($G(^DGPM(+QAOSAADM,0)),"^")\1):QAOSAADM,1:"")
 S QAOSDUP=0,QAOSD0=+$O(^QA(741,"AA",QAOSSCRN,QAOSDATE,QAOSDFN,0))
 I QAOSD0 S QAOSDUP=1 G INFILE
 K DD,DIC,DINUM,DO S DIC="^QA(741,",DIC(0)="L",DLAYGO=741,X=QAOSDFN
 D FILE^DICN S QAOSD0=+Y
 S DIE="^QA(741,",DA=QAOSD0
 S DR="1///^S X=QAOSDATE;3///`"_QAOSSCRN_";11///^S X=0;28///^S X=QAMTODAY"
 S:QAOSAADM DR=DR_";.02///`"_QAOSAADM
 S:QAOSWARD DR=DR_";4///`"_QAOSWARD
 S:QAOSSERV DR=DR_";5///`"_QAOSSERV
 S:QAOSTXSP DR=DR_";6///`"_QAOSTXSP
 S:QAOSSCRN=109 DR=DR_";19///3"
 D ^DIE
 S QAUDIT("FILE")="741^27",QAUDIT("DA")=QAOSD0,QAUDIT("ACTION")="o"
 S QAUDIT("COMMENT")="AUTO ENROLLED OCCURRENCE" D ^QAQAUDIT
 S ^TMP("QAO",$J,"WKS",QAOSDIVN,QAOSDFN(0),QAOSD0)=""
INFILE S DFN=QAOSDFN D PID^VADPT6 S QAOSPID=VA("PID")
 S ^TMP("QAO",$J,"RPT",QAOSDIVN,$E("*",QAOSDUP)_QAOSDFN(0),QAOSD0)=QAOSPID_"^"_QAOSWARD_"^"_QAOSDIAG_"^"_QAOSMVDT
 Q
SCRN ;;TOTAL FIELD FOR EACH SCREEN IN FILE #741.99
1010 ;;1
1011 ;;1.1
1020 ;;2
1030 ;;3
1041 ;;4.1
1042 ;;4.2
1051 ;;5.1
1052 ;;5.2
1061 ;;6.1
1062 ;;6.2
1070 ;;7
1080 ;;8
1090 ;;9
1990 ;;99